update_2d_bdy.F90 5.31 KB
Newer Older
kbk's avatar
kbk committed
1
!$Id: update_2d_bdy.F90,v 1.8 2006-03-01 15:54:07 kbk Exp $
gotm's avatar
gotm committed
2 3 4 5
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
6
! !IROUTINE: update_2d_bdy - update 2D boundaries every time step.
gotm's avatar
gotm committed
7 8 9 10 11 12
!
! !INTERFACE:
   subroutine update_2d_bdy(loop,bdyramp)
!
! !DESCRIPTION:
!
hb's avatar
hb committed
13 14 15 16 17 18 19 20 21
! In this routine sea surface elevation boundary conditions are read
! in from a file, interpolated to the actual time step, and distributed
! to the open boundary grid boxes. 
! Only for a special test case ({\tt SYLT\_TEST}), ascii data reading is
! supported. For a few special simple cases, analytical calculation
! of boundary elevations is supported. The generic way is reading in
! boundary data from a netcdf file, which is managed in
! {\tt get\_2d\_bdy} via {\tt get\_2d\_bdy\_ncdf}.
!
gotm's avatar
gotm committed
22 23
! !USES:
   use domain, only: NWB,NNB,NEB,NSB,H,min_depth,imin,imax,jmin,jmax,az
24
   use domain, only: wi,wfj,wlj,nj,nfi,nli,ei,efj,elj,sj,sfi,sli
kbk's avatar
kbk committed
25 26 27
   use domain, only: bdy_index,nsbv
   use m2d, only: dtm,bdyfmt_2d,bdy_data
   use variables_2d, only: z
gotm's avatar
gotm committed
28 29 30
   IMPLICIT NONE
!
! !INPUT PARAMETERS:
kbk's avatar
kbk committed
31
   integer, intent(in)                 :: loop,bdyramp
gotm's avatar
gotm committed
32 33 34 35 36
!
! !INPUT/OUTPUT PARAMETERS:
!
! !OUTPUT PARAMETERS:
!
kbk's avatar
kbk committed
37 38 39
! !REVISION HISTORY:
!  Original author(s): Karsten Bolding & Hans Burchard
!
gotm's avatar
gotm committed
40
! !LOCAL VARIABLES:
kbk's avatar
kbk committed
41 42 43 44 45
   logical, save             :: first=.true.
   REALTYPE, save            :: time_array(1000),zbo(1000),zbn(1000)
   REALTYPE, save            :: t,t1,t2
   REALTYPE                  :: a,amp,ratio,fac
   integer                   :: i,j,k,l,n
46
   REALTYPE, parameter       :: FOUR=4.*_ONE_
gotm's avatar
gotm committed
47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
!
!EOP
!-----------------------------------------------------------------------
!BOC
#ifdef DEBUG
   integer, save :: Ncall = 0
   Ncall = Ncall+1
   write(debug,*) 'update_2d_bdy() # ',Ncall
#endif

   zbo = _ZERO_
   zbn = _ZERO_

   t = loop*dtm

   select case (bdyfmt_2d)
      case (ANALYTICAL)
#define OMEGA 2.*3.141592654/43200.
#ifdef COAST_TEST
         amp = 1.5
         bdy_data = amp*sin(OMEGA*t)
#endif
#ifdef WADDEN_SEA_TEST
         amp = 1.5
         bdy_data = amp*sin(OMEGA*t)
#endif
kbk's avatar
kbk committed
73 74
#ifdef FRESHWATER_LENSE_TEST
         bdy_data=_ZERO_
gotm's avatar
gotm committed
75 76 77 78 79 80 81 82 83
#endif
#undef OMEGA
#ifdef CHANNEL_TEST
         stop 'CHANNEL_TEST - update2dbdy'
         z(1,:)  =  0.01
         z(51,:) = -0.01
#endif
#undef KBK_TESTING
#ifdef CURVI_TEST
kbk's avatar
kbk committed
84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
         k = 0
         do n=1,NWB
            i = wi(n)
            if (n .eq. 1) then
               a = 0.05
            else
               a = -0.05
            end if
            do j=wfj(1),wlj(1)
               k = k+1
               bdy_data(k) = a
            end do
         end do
         do n=1,NEB
            i = ei(n)
            do j=efj(1),elj(1)
               k = k+1
               bdy_data(k) = -0.05
            end do
         end do
gotm's avatar
gotm committed
104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145
#endif
      case (ASCII)
#ifdef SYLT_TEST
         if (first) then
            first = .false.

            if (bdyfmt_2d .eq. 1) then
               open(BDYDATA,file='bdy_data.dat')
               t1 = 0.
               do i=1,nsbv
                  read(BDYDATA,*) zbo(i)
               end do
               t2 = 44714./80
               do i=1,nsbv
                  read(BDYDATA,*) zbn(i)
               end do
            end if
         end if

!  Read in new boundary values
         if (t .ge. t2) then
            t1 = t2
            t2 = t2+44714./80
            zbo = zbn

            STDERR 'Reading new boundary values.... '
            do i=1,nsbv
               read(BDYDATA,*) zbn(i)
            end do
         end if
#endif
      case (NETCDF)
!        Read in get_2d_bdy() via get_2d_bdy_ncdf()
      case default
         FATAL 'A non valid communication method has been chosen'
         stop 'update2dbdy'
   end select

!  Data read - do time interpolation

   ratio = _ONE_
   fac = _ONE_
146
   if(bdyramp .gt. 1) fac=min( _ONE_ ,FOUR*loop/float(bdyramp))
gotm's avatar
gotm committed
147

kbk's avatar
kbk committed
148
   l = 0
gotm's avatar
gotm committed
149
   do n = 1,NWB
kbk's avatar
kbk committed
150 151
      l = l+1
      k = bdy_index(l)
gotm's avatar
gotm committed
152 153 154
      i = wi(n)
      do j = wfj(n),wlj(n)
         z(i,j) = max(fac*bdy_data(k),-H(i,j)+min_depth)
kbk's avatar
kbk committed
155
         k = k+1
gotm's avatar
gotm committed
156 157
      end do
   end do
kbk's avatar
kbk committed
158

gotm's avatar
gotm committed
159
   do n = 1,NNB
kbk's avatar
kbk committed
160 161
      l = l+1
      k = bdy_index(l)
gotm's avatar
gotm committed
162 163 164
      j = nj(n)
      do i = nfi(n),nli(n)
         z(i,j) = max(fac*bdy_data(k),-H(i,j)+min_depth)
kbk's avatar
kbk committed
165
         k = k+1
gotm's avatar
gotm committed
166 167 168 169
      end do
   end do

   do n = 1,NEB
kbk's avatar
kbk committed
170 171
      l = l+1
      k = bdy_index(l)
gotm's avatar
gotm committed
172 173 174
      i = ei(n)
      do j = efj(n),elj(n)
         z(i,j) = max(fac*bdy_data(k),-H(i,j)+min_depth)
kbk's avatar
kbk committed
175
         k = k+1
gotm's avatar
gotm committed
176 177 178 179
      end do
   end do

   do n = 1,NSB
kbk's avatar
kbk committed
180 181
      l = l+1
      k = bdy_index(l)
gotm's avatar
gotm committed
182 183 184
      j = sj(n)
      do i = sfi(n),sli(n)
         z(i,j) = max(fac*bdy_data(k),-H(i,j)+min_depth)
kbk's avatar
kbk committed
185
         k = k+1
gotm's avatar
gotm committed
186 187
      end do
   end do
kbk's avatar
kbk committed
188

gotm's avatar
gotm committed
189 190 191 192 193
#ifdef WADDEN_SEA_TEST
   i=imin
   do j=1,90
      if (az(i+2,j).eq.2) then
         a=z(i+1,j)+z(i+1,j)-z(i+2,j)
kbk's avatar
kbk committed
194
      else
gotm's avatar
gotm committed
195
         a=z(i+1,j)
kbk's avatar
kbk committed
196
      end if
gotm's avatar
gotm committed
197 198 199 200 201 202 203 204
      if (az(i,j).eq.2) z(i,j)= max(a,-H(i,j)+min_depth)
   end do
   i=imax
   do j=1,127
      if (az(i-2,j).eq.2) then
         a=z(i-1,j)+z(i-1,j)-z(i-2,j)
      else
         a=z(i-1,j)
kbk's avatar
kbk committed
205
      end if
gotm's avatar
gotm committed
206 207 208 209 210 211 212 213 214 215 216 217 218 219 220
      if (az(i,j).eq.2) z(i,j)= max(a,-H(i,j)+min_depth)
   end do
#endif

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

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