!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.7 (r4786) - 21 Feb 2013 15:53
!
!  Differentiation of surface_drag in forward (tangent) mode (with options r8):
!   variations   of useful results: rublten rvblten
!   with respect to varying inputs: v_phy rublten z rvblten u_phy
!-------------------------------------------------------------------
!WRF:MODEL_LAYER:PHYSICS
MODULE g_module_bl_surface_drag
CONTAINS

SUBROUTINE G_SURFACE_DRAG(rublten, rubltend, rvblten, rvbltend, u_phy, &
&  u_phyd, v_phy, v_phyd, xland, z, zd, ht, kpbl2d, ids, ide, jds, jde, &
&  kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte)
  IMPLICIT NONE
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
&  jme, kms, kme, its, ite, jts, jte, kts, kte
  INTEGER, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: kpbl2d
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rublten, &
&  rvblten
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rubltend&
&  , rvbltend
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: u_phy, v_phy&
&  , z
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: u_phyd, &
&  v_phyd, zd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: xland, ht
! Local
  REAL :: v0, tao_xz, tao_yz, cd, zh, zwt
  REAL :: v0d, tao_xzd, tao_yzd, cdd, zhd, zwtd
  INTEGER :: i, j, i_start, i_end, i_endu, j_start, j_end, j_endv, k
  REAL :: arg1
  REAL :: arg1d
  REAL :: abs1
  REAL :: abs0
! End declarations.
!-----------------------------------------------------------------------
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  i_endu = ite
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
  j_endv = jte
  DO j=j_start,j_end
    DO i=i_start,i_endu
      arg1d = 2*u_phy(i, kts, j)*u_phyd(i, kts, j) + 2*v_phy(i, kts, j)*&
&        v_phyd(i, kts, j)
      arg1 = u_phy(i, kts, j)**2 + v_phy(i, kts, j)**2
      IF (arg1 .EQ. 0.0_8) THEN
        v0d = 0.0_8
      ELSE
        v0d = arg1d/(2.0*SQRT(arg1))
      END IF
      v0 = SQRT(arg1)
      IF (xland(i, j) - xland(i-1, j) .GE. 0.) THEN
        abs0 = xland(i, j) - xland(i-1, j)
      ELSE
        abs0 = -(xland(i, j)-xland(i-1, j))
      END IF
      IF (abs0 .LT. 1.0e-10) THEN
        IF (xland(i, j) .LT. 1.5) THEN
! land
          cd = 0.01
          cdd = 0.0_8
        ELSE
! water
          cd = 0.001
          IF (cd .LT. 1.e-4*v0) THEN
            cdd = 1.e-4*v0d
            cd = 1.e-4*v0
          ELSE
            cd = cd
            cdd = 0.0_8
          END IF
          IF (cd .GT. 0.003) THEN
            cd = 0.003
            cdd = 0.0_8
          ELSE
            cd = cd
          END IF
        END IF
      ELSE
! coast
        cd = 0.003
        cdd = 0.0_8
      END IF
      tao_xzd = (cdd*v0+cd*v0d)*u_phy(i, kts, j) + cd*v0*u_phyd(i, kts, &
&        j)
      tao_xz = cd*v0*u_phy(i, kts, j)
      DO k=kts,kte
        zhd = zd(i, k, j)
        zh = z(i, k, j) - ht(i, j)
        IF (zh .LT. 1000.) THEN
          zwtd = (-(2.*zhd))/1000.
          zwt = 2.*(1000.-zh)/1000.
          rubltend(i, k, j) = rubltend(i, k, j) - 0.5*(zwtd*tao_xz+zwt*&
&            tao_xzd)/1000.
          rublten(i, k, j) = rublten(i, k, j) - zwt*0.5*tao_xz/1000.
          kpbl2d(i, j) = k
        END IF
      END DO
    END DO
  END DO
!
  DO j=j_start,j_endv
    DO i=i_start,i_end
      arg1d = 2*u_phy(i, kts, j)*u_phyd(i, kts, j) + 2*v_phy(i, kts, j)*&
&        v_phyd(i, kts, j)
      arg1 = u_phy(i, kts, j)**2 + v_phy(i, kts, j)**2
      IF (arg1 .EQ. 0.0_8) THEN
        v0d = 0.0_8
      ELSE
        v0d = arg1d/(2.0*SQRT(arg1))
      END IF
      v0 = SQRT(arg1)
      IF (xland(i, j) - xland(i, j-1) .GE. 0.) THEN
        abs1 = xland(i, j) - xland(i, j-1)
      ELSE
        abs1 = -(xland(i, j)-xland(i, j-1))
      END IF
      IF (abs1 .LT. 1.0e-10) THEN
        IF (xland(i, j) .LT. 1.5) THEN
! land
          cd = 0.01
          cdd = 0.0_8
        ELSE
! water
          cd = 0.001
          IF (cd .LT. 1.e-4*v0) THEN
            cdd = 1.e-4*v0d
            cd = 1.e-4*v0
          ELSE
            cd = cd
            cdd = 0.0_8
          END IF
          IF (cd .GT. 0.003) THEN
            cd = 0.003
            cdd = 0.0_8
          ELSE
            cd = cd
          END IF
        END IF
      ELSE
! coast
        cd = 0.003
        cdd = 0.0_8
      END IF
      tao_yzd = (cdd*v0+cd*v0d)*v_phy(i, kts, j) + cd*v0*v_phyd(i, kts, &
&        j)
      tao_yz = cd*v0*v_phy(i, kts, j)
      DO k=kts,kte
        zhd = zd(i, k, j)
        zh = z(i, k, j) - ht(i, j)
        IF (zh .LT. 1000.) THEN
          zwtd = (-(2.*zhd))/1000.
          zwt = 2.*(1000.-zh)/1000.
          rvbltend(i, k, j) = rvbltend(i, k, j) - 0.5*(zwtd*tao_yz+zwt*&
&            tao_yzd)/1000.
          rvblten(i, k, j) = rvblten(i, k, j) - zwt*0.5*tao_yz/1000.
        END IF
      END DO
    END DO
  END DO
END SUBROUTINE G_SURFACE_DRAG

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.6 (r4343) - 10 Feb 2012 10:52
!
!  Differentiation of surface_drag_init in forward (tangent) mode:
!   variations   of useful results: rublten rqvblten rvblten rthblten
!   with respect to varying inputs: rublten rqvblten rvblten rthblten
SUBROUTINE SURFACE_DRAG_INIT_D(rublten, rubltend, rvblten, rvbltend, &
&  rthblten, rthbltend, rqvblten, rqvbltend, restart, ids, ide, jds, jde&
&  , kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte&
&)
  IMPLICIT NONE
!-------------------------------------------------------------------
  LOGICAL, INTENT(IN) :: restart
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
&  jme, kms, kme, its, ite, jts, jte, kts, kte
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT) :: rublten, &
&  rvblten, rthblten, rqvblten
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT) :: rubltend, &
&  rvbltend, rthbltend, rqvbltend
  INTEGER :: i, j, k, itf, jtf, ktf
  INTRINSIC MIN0
  IF (jte .GT. jde - 1) THEN
    jtf = jde - 1
  ELSE
    jtf = jte
  END IF
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
  IF (ite .GT. ide - 1) THEN
    itf = ide - 1
  ELSE
    itf = ite
  END IF
  IF (.NOT.restart) THEN
    DO j=jts,jtf
      DO k=kts,ktf
        DO i=its,itf
          rubltend(i, k, j) = 0.0
          rublten(i, k, j) = 0.
          rvbltend(i, k, j) = 0.0
          rvblten(i, k, j) = 0.
          rthbltend(i, k, j) = 0.0
          rthblten(i, k, j) = 0.
          rqvbltend(i, k, j) = 0.0
          rqvblten(i, k, j) = 0.
        END DO
      END DO
    END DO
  END IF
END SUBROUTINE SURFACE_DRAG_INIT_D

END MODULE g_module_bl_surface_drag