slow_advection.F90 4.71 KB
Newer Older
kbk's avatar
kbk committed
1
!$Id: slow_advection.F90,v 1.10 2006-03-01 15:54:08 kbk Exp $
gotm's avatar
gotm committed
2 3 4 5
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
6
! !ROUTINE: slow_advection - slow advection terms \label{sec-slow-advection}
gotm's avatar
gotm committed
7 8 9 10 11 12
!
! !INTERFACE:
   subroutine slow_advection
!
! !DESCRIPTION:
!
13 14 15 16 17 18 19 20 21
! Here, the calculation of the advective slow terms $S^x_A$ and $S^y_A$
! (see eqs.\ (\ref{SxA}) and (\ref{SyA})) is prepared. This routine
! basically repeats the calculations made in the routine {\tt uv\_advect}, 
! see section \ref{sec-uv-advect}, but this time based on the macro time
! step averaged and vertically integrated transports {\tt Uint} and {\tt Vint}.
! The calculations of  $S^x_A$ and $S^y_A$ are then completed in the 
! routine {\tt slow\_terms}, see section \ref{sec-slow-terms} on page 
! \pageref{sec-slow-terms}.
!
gotm's avatar
gotm committed
22
! !USES:
23
   use domain, only: iimin,iimax,jjmin,jjmax,HU,HV,az,au,av,ax
kbk's avatar
kbk committed
24
   use domain, only: H,min_depth
gotm's avatar
gotm committed
25 26 27 28 29
#if defined(SPHERICAL) || defined(CURVILINEAR)
   use domain, only: dyc,arud1,dxx,dyx,arvd1,dxc
#else
   use domain, only: dx,dy,ard1
#endif
30
   use variables_2d, only: UEx,VEx,Uint,Vint,PP
kbk's avatar
kbk committed
31
   use variables_3d, only: ssun,ssvn
gotm's avatar
gotm committed
32 33 34 35 36 37 38 39
   IMPLICIT NONE
!
! !INPUT PARAMETERS:
!
! !INPUT/OUTPUT PARAMETERS:
!
! !OUTPUT PARAMETERS:
!
kbk's avatar
kbk committed
40 41 42
! !REVISION HISTORY:
!  Original author(s): Hans Burchard & Karsten Bolding
!
gotm's avatar
gotm committed
43
! !LOCAL VARIABLES:
kbk's avatar
kbk committed
44 45 46
   integer                   :: i,j,ii,jj
   REALTYPE                  :: DUi(I2DFIELD)
   REALTYPE                  :: DVi(I2DFIELD)
gotm's avatar
gotm committed
47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64
!EOP
!-----------------------------------------------------------------------
!BOC
#ifdef DEBUG
   integer, save :: Ncall = 0
   Ncall = Ncall+1
   write(debug,*) 'slow_advection() # ',Ncall
#endif
   do j=jjmin-1,jjmax+1
      do i=iimin-1,iimax+1
         DUi(i,j)=ssun(i,j)+HU(i,j)
         DVi(i,j)=ssvn(i,j)+HV(i,j)
      end do
   end do

! Upstream for dx(U^2/D)
   do j=jjmin,jjmax
      do i=iimin,iimax+1         ! PP defined on T-points
kbk's avatar
kbk committed
65
         if (az(i,j) .ge. 1) then
gotm's avatar
gotm committed
66 67
            PP(i,j)=0.5*(Uint(i-1,j)+Uint(i,j))
            if (PP(i,j) .gt. _ZERO_ ) then
gotm's avatar
gotm committed
68 69 70 71 72
               ii=i-1
            else
               ii=i
            end if
            PP(i,j)=PP(i,j)*Uint(ii,j)/DUi(ii,j)*DYC
73 74
         else
            PP(i,j) = _ZERO_
gotm's avatar
gotm committed
75
         end if
gotm's avatar
gotm committed
76 77 78 79
      end do
   end do
   do j=jjmin,jjmax
      do i=iimin,iimax           ! UEx defined on U-points
80
         if (au(i,j) .eq. 1) then
gotm's avatar
gotm committed
81
            UEx(i,j)=(PP(i+1,j)-PP(i  ,j))*ARUD1
kbk's avatar
kbk committed
82
         end if
gotm's avatar
gotm committed
83 84 85
      end do
   end do

86
#ifndef SLICE_MODEL
kbk's avatar
kbk committed
87 88
!  Upstream for dy(UV/D)
   do j=jjmin-1,jjmax     ! PP defined on X-points
89 90
      do i=iimin,iimax
         if (ax(i,j) .ge. 1) then
gotm's avatar
gotm committed
91
            PP(i,j)=0.5*(Vint(i+1,j)+Vint(i,j))
gotm's avatar
gotm committed
92 93 94 95 96 97
            if (PP(i,j) .gt. _ZERO_) then
               jj=j
            else
               jj=j+1
            end if
            PP(i,j)=PP(i,j)*Uint(i,jj)/DUi(i,jj)*DXX
98 99
         else
            PP(i,j) = _ZERO_
gotm's avatar
gotm committed
100
         end if
gotm's avatar
gotm committed
101 102 103 104
      end do
   end do
   do j=jjmin,jjmax
      do i=iimin,iimax       !UEx defined on U-points
105
         if (au(i,j) .eq. 1) then
gotm's avatar
gotm committed
106 107
            UEx(i,j)=UEx(i,j)+(PP(i,j  )-PP(i,j-1))*ARUD1
         end if
gotm's avatar
gotm committed
108 109
      end do
   end do
110
#endif
gotm's avatar
gotm committed
111 112

! Upstream for dx(UV/D)
113
   do j=jjmin,jjmax
gotm's avatar
gotm committed
114
      do i=iimin-1,iimax      ! PP defined on X-points
115
         if (ax(i,j) .ge. 1) then
gotm's avatar
gotm committed
116
            PP(i,j)=0.5*(Uint(i,j)+Uint(i,j+1))
gotm's avatar
gotm committed
117 118 119 120 121
            if (PP(i,j) .gt. _ZERO_) then
               ii=i
            else
               ii=i+1
            end if
kbk's avatar
kbk committed
122
            PP(i,j)=PP(i,j)*Vint(ii,j)/DVi(ii,j)*DYX
123 124
         else
            PP(i,j) = _ZERO_
gotm's avatar
gotm committed
125
         end if
gotm's avatar
gotm committed
126 127 128 129
      end do
   end do
   do j=jjmin,jjmax
      do i=iimin,iimax       ! VEx defined on V-points
130
         if (av(i,j) .eq. 1) then
gotm's avatar
gotm committed
131 132
            VEx(i,j)=(PP(i  ,j)-PP(i-1,j))*ARVD1
         end if
gotm's avatar
gotm committed
133 134 135
      end do
   end do

136
#ifndef SLICE_MODEL
kbk's avatar
kbk committed
137 138 139 140
!  Upstream for dy(V^2/D)
   do j=jjmin,jjmax+1          ! PP defined on T-points
      do i=iimin,iimax
         if (az(i,j) .ge. 1) then
gotm's avatar
gotm committed
141 142 143 144 145 146 147
            PP(i,j)=0.5*(Vint(i,j-1)+Vint(i,j))
            if (PP(i,j) .gt. _ZERO_) then
               jj=j-1
            else
               jj=j
            end if
            PP(i,j)=PP(i,j)*Vint(i,jj)/DVi(i,jj)*DXC
148 149
         else
            PP(i,j) = _ZERO_
gotm's avatar
gotm committed
150
         end if
gotm's avatar
gotm committed
151 152
      end do
   end do
kbk's avatar
kbk committed
153 154
   do j=jjmin,jjmax           ! VEx defined on V-points
      do i=iimin,iimax
155
         if (av(i,j) .eq. 1) then
gotm's avatar
gotm committed
156 157
            VEx(i,j)=VEx(i,j)+(PP(i,j+1)-PP(i,j  ))*ARVD1
         end if
gotm's avatar
gotm committed
158 159
      end do
   end do
160
#endif
gotm's avatar
gotm committed
161 162 163 164 165 166 167 168 169 170 171 172

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

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