update_2d_bdy.F90 6.03 KB
Newer Older
kbk's avatar
kbk committed
1
!$Id: update_2d_bdy.F90,v 1.2 2003-04-07 15:45:05 kbk Exp $
gotm's avatar
gotm committed
2 3 4 5 6 7 8 9 10 11 12 13 14 15
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: update_2d_bdy() - update 2D boundaries every time step.
!
! !INTERFACE:
   subroutine update_2d_bdy(loop,bdyramp)
!
! !DESCRIPTION:
!
! !USES:
   use domain, only: NWB,NNB,NEB,NSB,H,min_depth,imin,imax,jmin,jmax,az
   use domain, only: wi,wfj,wlj,nj,nfi,nli,ei,efj,elj,sj,sfi,sli,nsbv
kbk's avatar
kbk committed
16 17 18
   use domain, only: bdy_index,nsbv
   use m2d, only: dtm,bdyfmt_2d,bdy_data
   use variables_2d, only: z
gotm's avatar
gotm committed
19 20 21 22 23 24 25 26 27 28 29 30 31
   IMPLICIT NONE
!
! !INPUT PARAMETERS:
   integer, intent(in)	:: loop,bdyramp
!
! !INPUT/OUTPUT PARAMETERS:
!
! !OUTPUT PARAMETERS:
!
! !REVISION HISTORY:
!  Original author(s): Karsten Bolding & Hans Burchard
!
!  $Log: update_2d_bdy.F90,v $
kbk's avatar
kbk committed
32 33 34 35 36
!  Revision 1.2  2003-04-07 15:45:05  kbk
!  parallel support
!
!  Revision 1.1.1.1  2002/05/02 14:00:45  gotm
!  recovering after CVS crash
gotm's avatar
gotm committed
37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
!
!  Revision 1.8  2001/10/17 13:15:35  bbh
!  Cleaning
!
!  Revision 1.7  2001/09/01 17:15:13  bbh
!  Forgot to remove a few print statements
!
!  Revision 1.6  2001/09/01 17:07:10  bbh
!  Ramping of surface elevation boundaries - via namelist
!
!  Revision 1.5  2001/08/27 11:53:13  bbh
!  TVD-advection for momentum added, some bugs removed
!
!  Revision 1.4  2001/08/01 08:26:50  bbh
!  ANALYTICAL - to test CURVILINEAR
!
!  Revision 1.3  2001/06/22 08:19:10  bbh
!  Compiler options such as USE_MASK and OLD_DRY deleted.
!  Open and passive boundary for z created.
!  Various inconsistencies removed.
!  wait_halo added.
!  Checked loop boundaries
!
!  Revision 1.2  2001/05/03 20:23:04  bbh
!  Also uses variables_2d
!
!  Revision 1.1.1.1  2001/04/17 08:43:08  bbh
!  initial import into CVS
!
! !LOCAL VARIABLES:
   logical, save :: first=.true.
   REALTYPE, save :: time_array(1000),zbo(1000),zbn(1000)
   REALTYPE, save :: t,t1,t2
   REALTYPE 	:: a,amp,ratio,fac
kbk's avatar
kbk committed
71
   integer	:: i,j,k,l,n
gotm's avatar
gotm committed
72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 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 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173
!
!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
#ifdef NOMADS_TEST
     bdy_data=0.
#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
        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
#endif
      case (ASCII)
#ifdef SYLT_TEST
         if (first) then
            first = .false.

            if (bdyfmt_2d .eq. 1) then
!               open(BDYDATA,file='databoun.dat')
               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_
   if(bdyramp .gt. 1) fac=min( _ONE_ ,4.*loop/float(bdyramp))

kbk's avatar
kbk committed
174
   l = 0
gotm's avatar
gotm committed
175
   do n = 1,NWB
kbk's avatar
kbk committed
176 177
      l = l+1
      k = bdy_index(l)
gotm's avatar
gotm committed
178 179 180
      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
181
         k = k+1
gotm's avatar
gotm committed
182 183 184
      end do
   end do
   do n = 1,NNB
kbk's avatar
kbk committed
185 186
      l = l+1
      k = bdy_index(l)
gotm's avatar
gotm committed
187 188 189
      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
190
         k = k+1
gotm's avatar
gotm committed
191 192 193 194
      end do
   end do

   do n = 1,NEB
kbk's avatar
kbk committed
195 196
      l = l+1
      k = bdy_index(l)
gotm's avatar
gotm committed
197 198 199
      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
200
         k = k+1
gotm's avatar
gotm committed
201 202 203 204
      end do
   end do

   do n = 1,NSB
kbk's avatar
kbk committed
205 206
      l = l+1
      k = bdy_index(l)
gotm's avatar
gotm committed
207 208 209
      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
210
         k = k+1
gotm's avatar
gotm committed
211 212
      end do
   end do
kbk's avatar
kbk committed
213 214

#if 0
gotm's avatar
gotm committed
215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270
#ifdef NS_06NM_TEST
   i=109
   do j=1,jmax
      if (az(i,j).eq.2) z(i,j)=0.4
   end do
#endif
#ifdef NS_03NM_TEST
   i=222
   do j=1,jmax
      if (az(i,j).eq.2) z(i,j)=0.4
   end do
#endif
#ifdef SYLT_TEST
   j=jmax
   do i=1,imax
      if (az(i,j-2).eq.2) then
         a=z(i,j-1)+z(i,j-1)-z(i,j-2)
      else
         a=z(i,j-1)
      end if 	
      if (az(i,j).eq.2) z(i,j)= max(a,-H(i,j)+min_depth)
   end do
#endif
#endif
#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)
      else	
         a=z(i+1,j)
      end if 	
      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)
      end if 	
      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               !
!-----------------------------------------------------------------------