sealevel.F90 2.85 KB
Newer Older
kbk's avatar
kbk committed
1
!$Id: sealevel.F90,v 1.11 2006-03-01 15:54:07 kbk Exp $
gotm's avatar
gotm committed
2 3 4 5
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
6
! !IROUTINE: sealevel - using the cont. eq. to get the sealevel.
gotm's avatar
gotm committed
7 8 9 10 11 12
!
! !INTERFACE:
   subroutine sealevel
!
! !DESCRIPTION:
!
hb's avatar
hb committed
13 14 15 16 17 18 19
! Here, the sea surface elevation is iterated according to the vertically
! integrated continuity equation given in (\ref{Elevation}) on page
! \pageref{Elevation}. 
!
! When working with the option {\tt SLICE\_MODEL}, the elevations
! at $j=2$ are copied to $j=3$.
!
gotm's avatar
gotm committed
20
! !USES:
kbk's avatar
kbk committed
21
   use domain, only: imin,imax,jmin,jmax,az,H
gotm's avatar
gotm committed
22 23 24 25 26
#if defined(SPHERICAL) || defined(CURVILINEAR)
   use domain, only : arcd1,dxv,dyu
#else
   use domain, only : dx,dy,ard1
#endif
kbk's avatar
kbk committed
27 28 29
   use m2d, only: dtm
   use variables_2d, only: z,zo,U,V
   use halo_zones, only : update_2d_halo,wait_halo,z_TAG
gotm's avatar
gotm committed
30 31 32 33 34 35 36 37
   IMPLICIT NONE
!
! !INPUT PARAMETERS:
!
! !INPUT/OUTPUT PARAMETERS:
!
! !OUTPUT PARAMETERS:
!
kbk's avatar
kbk committed
38 39 40
! !REVISION HISTORY:
!  Original author(s): Hans Burchard & Karsten Bolding
!
gotm's avatar
gotm committed
41
! !LOCAL VARIABLES:
kbk's avatar
kbk committed
42 43
   integer                   :: i,j
   REALTYPE                  :: kk
gotm's avatar
gotm committed
44 45 46 47 48 49 50 51 52 53
!
!EOP
!-----------------------------------------------------------------------
!BOC
#ifdef DEBUG
   integer, save :: Ncall = 0
   Ncall = Ncall+1
   write(debug,*) 'sealevel() # ',Ncall
#endif

kbk's avatar
kbk committed
54
   zo = z
gotm's avatar
gotm committed
55 56 57
   do j=jmin,jmax
      do i=imin,imax
         if (az(i,j) .eq. 1) then
58 59
            z(i,j)=z(i,j)-dtm*((U(i,j)*DYU-U(i-1,j  )*DYUIM1) &
                              +(V(i,j)*DXV-V(i  ,j-1)*DXVJM1))*ARCD1
kbk's avatar
kbk committed
60

kbk's avatar
kbk committed
61
#ifdef FRESHWATER_LENSE_TEST
62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77
       kk=1.0
       if ((((i.eq.1).or.(i.eq.imax)).and.(j.ge.1).and.(j.le.jmax)).or. &
           (((j.eq.1).or.(j.eq.jmax)).and.(i.ge.1).and.(i.le.imax)))    &
          z(i,j)=(1.-kk)*z(i,j)
       kk=0.5625
       if ((((i.eq.2).or.(i.eq.imax-1)).and.(j.ge.2).and.(j.le.jmax-1)).or. &
           (((j.eq.2).or.(j.eq.jmax-1)).and.(i.ge.2).and.(i.le.imax-1)))    &
          z(i,j)=(1.-kk)*z(i,j)
       kk=0.25
       if ((((i.eq.3).or.(i.eq.imax-2)).and.(j.ge.3).and.(j.le.jmax-2)).or. &
           (((j.eq.3).or.(j.eq.jmax-2)).and.(i.ge.3).and.(i.le.imax-2)))    &
           z(i,j)=(1.-kk)*z(i,j)
       kk=0.0625
       if ((((i.eq.4).or.(i.eq.imax-3)).and.(j.ge.4).and.(j.le.jmax-3)).or. &
           (((j.eq.4).or.(j.eq.jmax-3)).and.(i.ge.4).and.(i.le.imax-3)))    &
           z(i,j)=(1.-kk)*z(i,j)
gotm's avatar
gotm committed
78 79 80 81 82
#endif
         end if
      end do
   end do

83 84 85 86 87 88
#ifdef SLICE_MODEL
      do i=imin,imax
         z(i,3)=z(i,2)
      end do
#endif

gotm's avatar
gotm committed
89 90 91 92 93 94 95 96 97 98 99 100 101 102
   call update_2d_halo(z,z,az,imin,jmin,imax,jmax,z_TAG)
   call wait_halo(z_TAG)

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

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