C Date: Tue, 15 Dec 1998 08:58:24 -0500 (EST)
C From: Christopher.E.Naimie@Dartmouth.EDU (Christopher E. Naimie)
C Subject: SUBROUTINE REORDERINBE
C To: channah@emerald.bio.dfo.ca
C
C Charles,
C
C  Unfortunately there is a bug in the earlier copy of 
C  SUBROUTINE REORDERINBE that I sent you.  It does not affect 
C  bank150 simulations, but will affect any grid
C  for which the external boundary is not entirely wet.  
C  Below is the new version which fixes this problem.  
C  It is plug compatible with the old version.
C
C  Cheers,
C  Chris
C

C***********************************************************************
C***********************************************************************
      SUBROUTINE REORDERINBE(nndim,nbedim,x,y,inbe,nbe)
C-----------------------------------------------------------------------
C purpose: This subroutine determines the number of closed boundaries in
C           a 2-D triangular mesh
C
C restrictions:  Applicable only for Lablib Standard 2-D triangular mesh
C
C inputs:  nndim - dimension parameter for the number of nodes
C          nedim - dimension parameter for the number of elements
C          nbe - the number of boundary elements in the mesh
C          inbe - Lablib Standard incidence list for the boundary 
C                  elements
C
C outputs: The number of closed boundaries found is written to standard
C           out.  If an unclosed boundary is found, a message is written
C           to standard out.
C
C history: Written by Christopher E. Naimie
C          Dartmouth College
C          03 December 1998
C-----------------------------------------------------------------------
C
C ARGUMENTS
C
      integer nndim, nbedim
      integer nbe 
      real x(nndim),y(nndim)
      integer inbe(4,nbedim)
C
C local variables 
      integer nopen, nclo,ncflag, istop 
      integer ncount, node, inbe1i 
      integer ml,mr, n1, n2
      integer nstart, nhead, nmin
      integer i,j
C
C START OF EXECUTABLE CODE
C
      nopen=0
      nclo=0
      ncflag=0
      istop=0
C
C Normalize all boundary elements such that the material to the left
C of an observer standing on inbe(1,i), looking toward inbe(2,i) is 0
C
      do i=1,nbe
         if(inbe(3,i).EQ.0)then
            if(inbe(4,i).EQ.0)then
               write(2,*)'INVALID BOUNDARY ELEMENT:',i
               write(2,*)'  (INBE(J,I),J=1,4)=',(INBE(J,I),J=1,4)
               istop=1
            endif
         elseif(inbe(4,i).EQ.0)then
            if(inbe(3,i).EQ.0)then
               write(2,*)'INVALID BOUNDARY ELEMENT:',i
               write(2,*)'  (INBE(J,I),J=1,4)=',(INBE(J,I),J=1,4)
               istop=1
            endif
            inbe1i=inbe(1,i)
            inbe(1,i)=inbe(2,i)
            inbe(2,i)=inbe1i
            inbe(3,i)=0
            inbe(4,i)=inbe(3,i)
         else
            write(2,*)'INVALID BOUNDARY ELEMENT:',i
            write(2,*)'  (INBE(J,I),J=1,4)=',(INBE(J,I),J=1,4)
            istop=1
         endif
      enddo
C
C Ensure that each boundary node occurs once and only once in the first
C two rows of inbe
C
      do i=1,nbe
         node=inbe(1,i)
         if(inbe(2,i).EQ.node)then
            write(2,*)'INVALID BOUNDARY ELEMENT:',i
            write(2,*)'  (INBE(J,I),J=1,4)=',(INBE(J,I),J=1,4)
            istop=1
         endif
         ncount=0
         do j=1,i-1
            if(inbe(2,j).EQ.node)ncount=ncount+1
         enddo
         do j=i+1,nbe
            if(inbe(2,j).EQ.node)ncount=ncount+1
         enddo
         if(ncount.NE.1)then
            write(2,*)'INVALID BOUNDARY ELEMENT LIST - NODE: ',node
            write(2,*)' APPEARS ',ncount,' TIMES IN 2ND ROW OF INBE'
            istop=1
         endif
         ncount=1
         do j=1,i-1
            if(inbe(1,j).EQ.node)ncount=ncount+1
         enddo
         do j=i+1,nbe
            if(inbe(1,j).EQ.node)ncount=ncount+1
         enddo
         if(ncount.NE.1)then
            write(2,*)'INVALID BOUNDARY ELEMENT LIST - NODE: ',node
            write(2,*)' APPEARS ',ncount,' TIMES IN 1ST ROW OF INBE'
            istop=1
         endif
      enddo
C
C Find the entry in the boundary element list with the minimum x
C (this must be part of the outer boundary)
C
      nmin=inbe(1,1)
      do i=2,nbe
         if(x(inbe(1,i)).LT.x(nmin))nmin=inbe(1,i)
      enddo
C
C Find the boundary element which has its head at nmin
C
      do i=1,nbe
         if(inbe(2,i).EQ.nmin)then
            nstart=inbe(1,i)
            nhead=inbe(2,i)
            ml=inbe(3,i)
            mr=inbe(4,i)
            inbe(1,i)=inbe(1,1)
            inbe(2,i)=inbe(2,1)
            inbe(3,i)=inbe(3,1)
            inbe(4,i)=inbe(4,1)
            inbe(1,1)=nstart
            inbe(2,1)=nhead
            inbe(3,1)=ml
            inbe(4,1)=mr
            go to 10
         endif
      enddo
C
C Start with first boundary element in list and close boundaries
C
 10   do 20 i=2,nbe
         if(ncflag.EQ.1)then
            ncflag=0
            go to 20
         endif
         do 18 j=i,nbe
            if(inbe(1,j).EQ.nhead)then
               n1=inbe(1,i)
               n2=inbe(2,i)
               ml=inbe(3,i)
               mr=inbe(4,i)
               inbe(1,i)=inbe(1,j)
               inbe(2,i)=inbe(2,j)
               inbe(3,i)=inbe(3,j)
               inbe(4,i)=inbe(4,j)
               inbe(1,j)=n1
               inbe(2,j)=n2
               inbe(3,j)=ml
               inbe(4,j)=mr
               nhead=inbe(2,i)
               go to 19
            endif
 18      continue
         if(i.LT.(nbe))then
            nopen=nopen+1
            nstart=inbe(1,i)
            nhead=inbe(2,i)
            istop=1
         endif
         go to 20           
 19      if(inbe(2,i).EQ.nstart.AND.i.LT.nbe)then
            nclo=nclo+1
            ncflag=1
            nstart=inbe(1,i+1)
            nhead=inbe(2,i+1)
         endif
         if(inbe(2,i).EQ.nstart.AND.i.EQ.nbe)then
            nclo=nclo+1
            go to 21
         endif
 20   continue
      nopen=nopen+1
      istop=1
 21   continue
C
C Report statistical info and stop if errors were found
C
      if(istop.EQ.1)then
         WRITE(2,*)'EXECUTION TERMINATED IN SUBROUTINE REORDERINBE DUE',
     &             ' TO FATAL FLAW IN INPUT BOUNDARY ELEMENT FILE:'
         WRITE(2,*)NCLO,' CLOSED BOUNDARIES WERE FOUND.'
         WRITE(2,*)NOPEN,' OPEN BOUNDARIES WERE FOUND.'
         STOP
      endif
C
C END OF ROUTINE
C
      return
      end
C***********************************************************************
C***********************************************************************
