have_bdy.F90 4.27 KB
Newer Older
gotm's avatar
gotm committed
1 2 3 4
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
5
! !IROUTINE: have_bdy - checks whether this node has boundaries.
gotm's avatar
gotm committed
6 7 8 9 10 11
!
! !INTERFACE:
   subroutine have_bdy
!
! !DESCRIPTION:
!
hb's avatar
hb committed
12 13 14 15
! This routine which is called in {\tt domain.F90} checks whether the present
! node has open lateral boundaries. The integer field {\tt bdy\_index}
! is then set accordingly.
!
gotm's avatar
gotm committed
16 17
! !USES:
   use domain
kbk's avatar
kbk committed
18
   use m2d, only: have_boundaries
gotm's avatar
gotm committed
19 20
   IMPLICIT NONE
!
kbk's avatar
kbk committed
21 22 23
! !REVISION HISTORY:
!  Original author(s): Karsten Bolding & Hans Burchard
!
gotm's avatar
gotm committed
24
! !LOCAL VARIABLES:
kb's avatar
kb committed
25
   integer                   :: i,j,k,m,n
kbk's avatar
kbk committed
26 27
   integer                   :: nbdy
   integer                   :: f,l
gotm's avatar
gotm committed
28 29 30 31 32 33 34 35 36 37 38
!EOP
!-----------------------------------------------------------------------
!BOC
#ifdef DEBUG
   integer, save :: Ncall = 0
   Ncall = Ncall+1
   write(debug,*) 'have_bdy() # ',Ncall
#endif

   nbdy = 0
   i = 0
kb's avatar
kb committed
39
   m = 0
gotm's avatar
gotm committed
40 41
   if (NWB .ge. 1) then
      do n = 1,NWB
kb's avatar
kb committed
42
         m = m+1
kbk's avatar
kbk committed
43 44 45 46
         if (wi(n) .ge. imin+ioff .and. wi(n) .le. imax+ioff) then
            f = max(jmin+joff,wfj(n)) - joff
            l = min(jmax+joff,wlj(n)) - joff
            if(f .le. l) then
gotm's avatar
gotm committed
47
               i = i+1
48
               wi(i) = wi(n) - ioff
gotm's avatar
gotm committed
49 50 51
               wfj(i) = f
               wlj(i) = l
               nbdy = nbdy+1
kb's avatar
kb committed
52
               bdy_2d_type(nbdy) = bdy_2d_type(m)
53 54 55 56 57 58
               do k=1,nsbv
                  if (bdy_map(k,1) .eq. wi(i)+ioff .and. &
                      bdy_map(k,2) .eq. f+joff) then
                     bdy_index(nbdy) = k
                  end if
               end do
gotm's avatar
gotm committed
59 60 61 62 63 64 65 66 67
            end if
         end if
      end do
   end if
   NWB = i

   i = 0
   if (NNB .ge. 1) then
      do n = 1,NNB
kb's avatar
kb committed
68
         m = m+1
kbk's avatar
kbk committed
69 70 71 72
         if (nj(n) .ge. jmin+joff .and. nj(n) .le. jmax+joff) then
            f = max(imin+ioff,nfi(n)) - ioff
            l = min(imax+ioff,nli(n)) - ioff
            if(f .le. l) then
gotm's avatar
gotm committed
73 74 75
               i = i+1
               nfi(i) = f
               nli(i) = l
76
               nj(i) = nj(n) - joff
gotm's avatar
gotm committed
77
               nbdy = nbdy+1
kb's avatar
kb committed
78
               bdy_2d_type(nbdy) = bdy_2d_type(m)
79 80 81 82 83 84
               do k=1,nsbv
                  if (bdy_map(k,1) .eq. f+ioff .and.  &
                      bdy_map(k,2) .eq. nj(i)+joff) then
                     bdy_index(nbdy) = k
                  end if
               end do
gotm's avatar
gotm committed
85 86 87 88 89 90 91 92 93
            end if
         end if
      end do
   end if
   NNB = i

   i = 0
   if (NEB .ge. 1) then
      do n = 1,NEB
kb's avatar
kb committed
94
         m = m+1
kbk's avatar
kbk committed
95 96 97 98
         if (ei(n) .ge. imin+ioff .and. ei(n) .le. imax+ioff) then
            f = max(jmin+joff,efj(n)) - joff
            l = min(jmax+joff,elj(n)) - joff
            if(f .le. l) then
gotm's avatar
gotm committed
99
               i = i+1
100
               ei(i) = ei(n) - ioff
gotm's avatar
gotm committed
101 102 103
               efj(i) = f
               elj(i) = l
               nbdy = nbdy+1
kb's avatar
kb committed
104
               bdy_2d_type(nbdy) = bdy_2d_type(m)
105 106
               do k=1,nsbv
                  if (bdy_map(k,1) .eq. ei(i)+ioff .and. &
107
                      bdy_map(k,2) .eq. f+joff) then
108 109 110
                     bdy_index(nbdy) = k
                  end if
               end do
gotm's avatar
gotm committed
111 112 113 114 115 116 117 118 119
            end if
         end if
      end do
   end if
   NEB = i

   i = 0
   if (NSB .ge. 1) then
      do n = 1,NSB
kb's avatar
kb committed
120
         m = m+1
kbk's avatar
kbk committed
121 122 123 124
         if (sj(n) .ge. jmin+joff .and. sj(n) .le. jmax+joff) then
            f = max(imin+ioff,sfi(n)) - ioff
            l = min(imax+ioff,sli(n)) - ioff
            if(f .le. l) then
gotm's avatar
gotm committed
125 126 127
               i = i+1
               sfi(i) = f
               sli(i) = l
128
               sj(i) = sj(n) - joff
gotm's avatar
gotm committed
129
               nbdy = nbdy+1
kb's avatar
kb committed
130
               bdy_2d_type(nbdy) = bdy_2d_type(m)
131 132 133 134 135 136
               do k=1,nsbv
                  if (bdy_map(k,1) .eq. f+ioff .and. &
                      bdy_map(k,2) .eq. sj(i)+joff) then
                     bdy_index(nbdy) = k
                  end if
               end do
gotm's avatar
gotm committed
137 138 139 140 141 142
            end if
         end if
      end do
   end if
   NSB = i

kbk's avatar
kbk committed
143 144 145 146 147 148 149
   if (nbdy .gt. 0) then
      have_boundaries = .true.
      bdy_index(nbdy+1:) = -1
   else
      have_boundaries = .false.
      bdy_index = -1
   end if
gotm's avatar
gotm committed
150 151 152 153 154 155 156 157 158 159 160 161

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

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