bottom_friction_3d.F90 5.59 KB
Newer Older
kbk's avatar
kbk committed
1
!$Id: bottom_friction_3d.F90,v 1.9 2006-03-01 15:54:08 kbk Exp $
gotm's avatar
gotm committed
2 3 4 5
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
hb's avatar
hb committed
6
! !ROUTINE: bottom_friction_3d - bottom friction
hb's avatar
hb committed
7
! \label{sec-bottom-friction-3d}
gotm's avatar
gotm committed
8 9 10 11 12 13
!
! !INTERFACE:
   subroutine bottom_friction_3d
!
! !DESCRIPTION:
!
hb's avatar
hb committed
14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
! Based on the assumption that the velocity distribution in the bottom
! layer is logarithmic,
! the product of the drag coefficient with the
! absolute value of the current speed in the bottom layer,
!
! \begin{equation}
! r \sqrt{u_b^2+v_b^2}
! \end{equation}
!
! with the velocity components of the bottom layer, $u_b$ and $v_b$,
! and the drag coefficient 
!
! \begin{equation}\label{r}
! r = \left(\frac{\kappa}{\ln \left(\frac{0.5h_1+z_0^b}{z_0^b}\right)}
! \right)^2,
! \end{equation}
!
! is calculated and
! provided as output parameters {\tt rru} (for U-points) and
! {\tt rrv} (for V-points). The layer height $h_1$ in (\ref{r}) is set to
! the thickness of the bottom layer in the respective U- or V-point.
! 
! There are some experimental options for the interested user included
! here. It is possible to change the interpolation of $u$ to V-points
! and of $v$ to U-points from velocity-based interpolation (as done
! presently) to transport-based averaging (commented out). Furthermore,
! the user may activate some outcommented lines which allow the
! consideration of flow-depending bottom roughness length $z_0^b$
! according to (\ref{Defz0b}), see page \pageref{Defz0b}.
!
! For a derivation of (\ref{r}), see section \ref{SectionBedFric} on
! page \pageref{SectionBedFric}.
!
gotm's avatar
gotm committed
47 48
! !USES:
   use parameters, only: kappa,avmmol
gotm's avatar
gotm committed
49 50 51
   use domain, only: iimin,iimax,jjmin,jjmax,kmax,au,av,min_depth
   use variables_2d, only: zub,zvb,zub0,zvb0
   use variables_3d, only: kumin,kvmin,uu,vv,huo,hun,hvo,hvn,rru,rrv
gotm's avatar
gotm committed
52 53 54 55 56 57 58 59
   IMPLICIT NONE
!
! !INPUT PARAMETERS:
!
! !INPUT/OUTPUT PARAMETERS:
!
! !OUTPUT PARAMETERS:
!
kbk's avatar
kbk committed
60 61 62
! !REVISION HISTORY:
!  Original author(s): Hans Burchard & Karsten Bolding
!
gotm's avatar
gotm committed
63
! !LOCAL VARIABLES:
kbk's avatar
kbk committed
64 65
   integer                   :: i,j,kk
   REALTYPE                  :: r,hh,fricvel
gotm's avatar
gotm committed
66
   logical, save             :: first=.true.
67 68 69 70
   REALTYPE                  :: uuloc(I2DFIELD)
   REALTYPE                  :: uvloc(I2DFIELD)
   REALTYPE                  :: vuloc(I2DFIELD)
   REALTYPE                  :: vvloc(I2DFIELD)
gotm's avatar
gotm committed
71 72 73 74 75 76 77 78 79
!EOP
!-----------------------------------------------------------------------
!BOC
#ifdef DEBUG
   integer, save :: Ncall = 0
   Ncall = Ncall+1
   write(debug,*) 'bottom_friction_3d() # ',Ncall
#endif

80
#if 0
gotm's avatar
gotm committed
81 82 83 84 85 86 87
   if(first) then
      uuloc = _ZERO_
      uvloc = _ZERO_
      vuloc = _ZERO_
      vvloc = _ZERO_
      first = .false.
   end if
88
#endif
gotm's avatar
gotm committed
89

gotm's avatar
gotm committed
90 91
   do j=jjmin,jjmax
      do i=iimin,iimax
gotm's avatar
gotm committed
92 93 94 95 96 97 98 99 100 101 102 103 104 105
         if (au(i,j) .ge. 1) then
            kk = kumin(i,j)
            uuloc(i,j)=uu(i,j,kk)/(huo(i,j,kk))
#if 0
            uvloc(i,j)=( vv(i,j  ,kk)+vv(i+1,j  ,kk)        &
                        +vv(i,j-1,kk)+vv(i+1,j-1,kk) )      &
                       /( hvo(i,j  ,kk)+hvo(i+1,j  ,kk)     &
                         +hvo(i,j-1,kk)+hvo(i+1,j-1,kk) )
#else
            uvloc(i,j)=0.25*( vv(i  ,j  ,kk)/hvo(i  ,j  ,kk)         &
                             +vv(i+1,j  ,kk)/hvo(i+1,j  ,kk)         &
                             +vv(i  ,j-1,kk)/hvo(i  ,j-1,kk)         &
                             +vv(i+1,j-1,kk)/hvo(i+1,j-1,kk) )
#endif
kbk's avatar
kbk committed
106 107 108
         else
            uuloc(i,j) = _ZERO_
            uvloc(i,j) = _ZERO_
gotm's avatar
gotm committed
109
         end if
gotm's avatar
gotm committed
110 111 112 113 114
      end do
   end do

   do j=jjmin,jjmax
      do i=iimin,iimax
gotm's avatar
gotm committed
115 116 117 118 119 120 121 122 123 124 125 126 127 128
         if (av(i,j) .ge. 1) then
            kk = kvmin(i,j)
#if 0
            vuloc(i,j)=( uu(i  ,j  ,kk) + uu(i-1,j  ,kk)       &
                      +  uu(i  ,j+1,kk) + uu(i-1,j+1,kk) )     &
                         /(huo(i,j  ,kk)+huo(i-1,j  ,kk)       &
                          +huo(i,j+1,kk)+huo(i-1,j+1,kk) )
#else
            vuloc(i,j)=0.25*( uu(i  ,j  ,kk)/huo(i  ,j  ,kk)    &
                            + uu(i-1,j  ,kk)/huo(i-1,j  ,kk)    &
                            + uu(i  ,j+1,kk)/huo(i  ,j+1,kk)    &
                            + uu(i-1,j+1,kk)/huo(i-1,j+1,kk) )
#endif
            vvloc(i,j)=vv(i,j,kk)/(hvo(i,j,kk))
kbk's avatar
kbk committed
129 130 131
         else
            vuloc(i,j) = _ZERO_
            vvloc(i,j) = _ZERO_
kbk's avatar
kbk committed
132
         end if
gotm's avatar
gotm committed
133 134 135
      end do
   end do

gotm's avatar
gotm committed
136
#if 1
gotm's avatar
gotm committed
137 138 139
   do j=jjmin,jjmax
      do i=iimin,iimax
         if (au(i,j) .ge. 1) then
gotm's avatar
gotm committed
140 141 142 143 144 145 146 147
            hh=max(min_depth/kmax,hun(i,j,kumin(i,j)))
            r=(zub(i,j)+0.5*hh)/zub(i,j)
            r=(kappa/log(r))**2
!            fricvel=sqrt(r*(uuloc(i,j)**2+uvloc(i,j)**2))
!            zub(i,j)=min(hh,zub0(i,j)+0.1*avmmol/max(avmmol,fricvel))
!            r=(zub(i,j)+0.5*hh)/zub(i,j)
!            r=(kappa/log(r))**2
            rru(i,j)=r*sqrt(uuloc(i,j)**2+uvloc(i,j)**2)
gotm's avatar
gotm committed
148 149 150
         end if
      end do
   end do
gotm's avatar
gotm committed
151
#endif
gotm's avatar
gotm committed
152

gotm's avatar
gotm committed
153
#if 1
gotm's avatar
gotm committed
154 155 156
   do j=jjmin,jjmax
      do i=iimin,iimax
         if (av(i,j) .ge. 1) then
gotm's avatar
gotm committed
157 158 159 160 161 162 163 164
            hh=max(min_depth/kmax,hvn(i,j,kvmin(i,j)))
            r=(zvb(i,j)+0.5*hh)/zvb(i,j)
            r=(kappa/log(r))**2
!            fricvel=sqrt(r*(vuloc(i,j)**2+vvloc(i,j)**2))
!            zvb(i,j)=min(hh,zvb0(i,j)+0.1*avmmol/max(avmmol,fricvel))
!            r=(zvb(i,j)+0.5*hh)/zvb(i,j)
!            r=(kappa/log(r))**2
            rrv(i,j)=r*sqrt(vuloc(i,j)**2+vvloc(i,j)**2)
gotm's avatar
gotm committed
165 166 167
         end if
      end do
   end do
gotm's avatar
gotm committed
168
#endif
gotm's avatar
gotm committed
169 170 171 172 173 174 175 176 177 178 179 180

#ifdef DEBUG
   write(debug,*) 'Leaving bottom_friction_3d()'
   write(debug,*)
#endif
   return
   end subroutine bottom_friction_3d
!EOC

!-----------------------------------------------------------------------
! Copyright (C) 2001 - Hans Burchard and Karsten Bolding               !
!-----------------------------------------------------------------------