have_bdy.F90 4.72 KB
Newer Older
hb's avatar
hb committed
1
!$Id: have_bdy.F90,v 1.6 2006-02-04 11:21:52 hb Exp $
gotm's avatar
gotm committed
2 3 4 5 6 7 8 9 10 11 12
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: have_bdy() - checks whether this node has boundaries.
!
! !INTERFACE:
   subroutine have_bdy
!
! !DESCRIPTION:
!
hb's avatar
hb committed
13 14 15 16
! 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
17 18
! !USES:
   use domain
kbk's avatar
kbk committed
19
   use m2d, only: have_boundaries
gotm's avatar
gotm committed
20 21 22 23 24 25 26 27 28 29 30 31
   IMPLICIT NONE
!
! !INPUT PARAMETERS:
!
! !INPUT/OUTPUT PARAMETERS:
!
! !OUTPUT PARAMETERS:
!
! !REVISION HISTORY:
!  Original author(s): Karsten Bolding & Hans Burchard
!
!  $Log: have_bdy.F90,v $
hb's avatar
hb committed
32 33 34
!  Revision 1.6  2006-02-04 11:21:52  hb
!  Source code documentation extended
!
35 36 37 38
!  Revision 1.5  2004-02-23 15:14:29  kbk
!  correct mapping of eastern boundary - Staneva
!
!  Revision 1.4  2003/05/06 16:02:53  kbk
39 40 41
!  now works with several boundaries on each side in parallel mode
!
!  Revision 1.3  2003/04/23 12:09:43  kbk
kbk's avatar
kbk committed
42 43 44
!  cleaned code + TABS to spaces
!
!  Revision 1.2  2003/04/07 15:42:05  kbk
kbk's avatar
kbk committed
45 46 47 48
!  parallel support
!
!  Revision 1.1.1.1  2002/05/02 14:00:44  gotm
!  recovering after CVS crash
gotm's avatar
gotm committed
49 50 51 52 53
!
!  Revision 1.1.1.1  2001/04/17 08:43:07  bbh
!  initial import into CVS
!
! !LOCAL VARIABLES:
kbk's avatar
kbk committed
54 55 56
   integer                   :: i,j,k,n
   integer                   :: nbdy
   integer                   :: f,l
gotm's avatar
gotm committed
57 58 59 60 61 62 63 64 65 66 67 68 69
!EOP
!-----------------------------------------------------------------------
!BOC
#ifdef DEBUG
   integer, save :: Ncall = 0
   Ncall = Ncall+1
   write(debug,*) 'have_bdy() # ',Ncall
#endif

   nbdy = 0
   i = 0
   if (NWB .ge. 1) then
      do n = 1,NWB
kbk's avatar
kbk committed
70 71 72 73
         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
74
               i = i+1
75
               wi(i) = wi(n) - ioff
gotm's avatar
gotm committed
76 77 78
               wfj(i) = f
               wlj(i) = l
               nbdy = nbdy+1
79 80 81 82 83 84
               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
85 86 87 88 89 90 91 92 93
            end if
         end if
      end do
   end if
   NWB = i

   i = 0
   if (NNB .ge. 1) then
      do n = 1,NNB
kbk's avatar
kbk committed
94 95 96 97
         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
98 99 100
               i = i+1
               nfi(i) = f
               nli(i) = l
101
               nj(i) = nj(n) - joff
gotm's avatar
gotm committed
102
               nbdy = nbdy+1
103 104 105 106 107 108
               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
109 110 111 112 113 114 115 116 117
            end if
         end if
      end do
   end if
   NNB = i

   i = 0
   if (NEB .ge. 1) then
      do n = 1,NEB
kbk's avatar
kbk committed
118 119 120 121
         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
122
               i = i+1
123
               ei(i) = ei(n) - ioff
gotm's avatar
gotm committed
124 125 126
               efj(i) = f
               elj(i) = l
               nbdy = nbdy+1
127 128
               do k=1,nsbv
                  if (bdy_map(k,1) .eq. ei(i)+ioff .and. &
129
                      bdy_map(k,2) .eq. f+joff) then
130 131 132
                     bdy_index(nbdy) = k
                  end if
               end do
gotm's avatar
gotm committed
133 134 135 136 137 138 139 140 141
            end if
         end if
      end do
   end if
   NEB = i

   i = 0
   if (NSB .ge. 1) then
      do n = 1,NSB
kbk's avatar
kbk committed
142 143 144 145
         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
146 147 148
               i = i+1
               sfi(i) = f
               sli(i) = l
149
               sj(i) = sj(n) - joff
gotm's avatar
gotm committed
150
               nbdy = nbdy+1
151 152 153 154 155 156
               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
157 158 159 160 161 162
            end if
         end if
      end do
   end if
   NSB = i

kbk's avatar
kbk committed
163 164 165 166 167 168 169
   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
170 171 172 173 174 175 176 177 178 179 180 181

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

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