segbor.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE segbor
!                   *****************
!
     &(nsegbor,ikles,nelem,npoin)
!
!***********************************************************************
! BIEF   V6P3                                   21/08/2010
!***********************************************************************
!
!brief    DETERMINES THE NUMBER OF BOUNDARY SEGMENTS OF THE MESH
!+               (INCLUDES INTERNAL BOUNDARIES IN PARALLEL MODE).
!+
!+            BASED UPON THE PRINCIPLE OF VOISIN,
!+                WHICH WILL BE CALLED LATER.
!
!history  J-M HERVOUET (LNHE)
!+        19/06/2008
!+        V5P9
!+
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!history  J-M HERVOUET (EDF R&D, LNHE)
!+        07/02/2013
!+        V6P3
!+   Removing argument NELMAX.
!
!history  S.E.BOURBAN (HRW)
!+        21/03/2017
!+        V7P3
!+   Replacement of the DATA declarations by the PARAMETER associates
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| IKLES          |-->| LIKE CONNECTIVITY TABLE BUT IN SELAFIN FORMAT
!|                |   | IKLES(3,NELEM) INSTEAD OF IKLE(NELEM,3)
!| NELEM          |-->| NUMBER OF ELEMENTS
!| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
!| NPOIN          |-->| NUMBER OF POINTS
!| NSEGBOR        |<--| NUMBER OF BOUNDARY SEGMENTS
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_segbor => segbor
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN)            :: NPOIN,NELEM
      INTEGER, INTENT(OUT)           :: NSEGBOR
      INTEGER, INTENT(IN)            :: IKLES(3,nelem)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER NFACE,NDP,KEL,IMAX,IFACE,IELEM,M1,M2,IV,IELEM2,IFACE2
      INTEGER I,ERR,I1,I2,IDIMAT
      INTEGER :: SOMFAC(2,4,2)
      parameter( somfac = reshape( (/
     &            1,2 , 2,3 , 3,1 , 0,0   ,
     &            1,2 , 2,3 , 3,4 , 4,1 /), shape=(/ 2,4,2 /) ) )
!
!     DYNAMICALLY ALLOCATES WORKING ARRAYS
!
      INTEGER, ALLOCATABLE :: IFABOR(:,:),MAT1(:),MAT2(:),MAT3(:)
      INTEGER, ALLOCATABLE :: NVOIS(:),IADR(:)
!
!-----------------------------------------------------------------------
!
      nface = 3
!     NUMBER OF POINTS PER ELEMENT
      ndp = 3
!     ADDRESS IN SOMFAC
      kel = 1
!
!     IDIMAT IS BIGGER THAN THE SUM OF THE NUMBER OF NEIGHBOURS FOR
!     ALL THE POINTS (NEIGHBOUR = LINKED BY A SEGMENT)
!
      idimat = ndp*2*nelem
!
      ALLOCATE(mat1(idimat),stat=err)
      ALLOCATE(mat2(idimat),stat=err)
      ALLOCATE(mat3(idimat),stat=err)
      ALLOCATE(ifabor(nelem,3),stat=err)
      ALLOCATE(nvois(npoin),stat=err)
      ALLOCATE(iadr(npoin),stat=err)
!
      IF(err.NE.0) THEN
        WRITE(lu,2000) err
2000    FORMAT(1x,'SEGBOR: ERROR DURING ALLOCATION OF MEMORY: ',/,1x,
     &            'ERROR CODE: ',1i6)
        CALL plante(1)
        stop
      ENDIF
!
!-----------------------------------------------------------------------
!
!  COMPUTES THE ARRAY NVOIS FOR EACH POINT
!  BEWARE : NVOIS IS BIGGER THAN THE NUMBER OF NEIGHBOURS
!           THE SUM OF NVOIS FOR ALL THE POINTS WILL GIVE IDIMAT
!
      DO i=1,npoin
        nvois(i) = 0
      ENDDO
!
      DO iface = 1,nface
        DO ielem=1,nelem
          i1 = ikles( somfac(1,iface,kel) , ielem )
          i2 = ikles( somfac(2,iface,kel) , ielem )
          nvois(i1) = nvois(i1) + 1
          nvois(i2) = nvois(i2) + 1
        ENDDO
      ENDDO
!
!-----------------------------------------------------------------------
!
!  COMPUTES THE ADDRESSES OF EACH POINT IN A STRUCTURE OF TYPE
!  COMPACT MATRIX
!
      iadr(1) = 1
      DO i= 2,npoin
        iadr(i) = iadr(i-1) + nvois(i-1)
      ENDDO ! I
!
      imax = iadr(npoin) + nvois(npoin) - 1
      IF(imax.GT.idimat) THEN
        WRITE(lu,52) idimat,imax
52      FORMAT(1x,'SEGBOR: SIZE OF MAT1,2,3 (',1i9,') TOO SHORT',/,
     &         1x,'MINIMUM SIZE: ',1i9)
        CALL plante(1)
        stop
      ENDIF
!
!-----------------------------------------------------------------------
!
!  INITIALISES THE COMPACT MATRIX TO 0
!
      DO i=1,imax
        mat1(i) = 0
      ENDDO
!
!-----------------------------------------------------------------------
!
!  LOOP ON THE SIDES OF EACH ELEMENT:
!
      DO iface = 1 , nface
      DO ielem = 1 , nelem
!
        ifabor(ielem,iface) = 0
!
!       GLOBAL NUMBERS OF THE POINTS OF THE SIDE:
!
        i1 = ikles( somfac(1,iface,kel) , ielem )
        i2 = ikles( somfac(2,iface,kel) , ielem )
!
!       ORDERED GLOBAL NUMBERS :
!
        m1 = min(i1,i2)
        m2 = max(i1,i2)
!
        DO iv = 1,nvois(m1)
!
          IF(mat1(iadr(m1)+iv-1).EQ.0) THEN
            mat1(iadr(m1)+iv-1)=m2
            mat2(iadr(m1)+iv-1)=ielem
            mat3(iadr(m1)+iv-1)=iface
            GO TO 81
          ELSEIF(mat1(iadr(m1)+iv-1).EQ.m2) THEN
            ielem2 = mat2(iadr(m1)+iv-1)
            iface2 = mat3(iadr(m1)+iv-1)
            ifabor(ielem,iface) = ielem2
            ifabor(ielem2,iface2) = ielem
            GO TO 81
          ENDIF
!
        ENDDO ! IV
!
        WRITE(lu,83)
83      FORMAT(1x,'SEGBOR : ERROR IN THE MESH             ',/,1x,
     &            '         MAYBE SUPERIMPOSED POINTS     ')
        CALL plante(1)
        stop
!
81      CONTINUE
!
      ENDDO ! IELEM
      ENDDO ! IFACE
!
      nsegbor = 0
      DO iface=1,nface
        DO ielem=1,nelem
          IF(ifabor(ielem,iface).EQ.0) nsegbor=nsegbor+1
        ENDDO
      ENDDO
!
      WRITE(lu,501) nsegbor
501   FORMAT(1x,'SEGBOR (BIEF) : NUMBER OF BOUNDARY SEGMENTS = ',1i6,/,
     &       1x,'INCLUDING THOSE DUE TO DOMAIN DECOMPOSITION')
!
!-----------------------------------------------------------------------
!
      DEALLOCATE(mat1)
      DEALLOCATE(mat2)
      DEALLOCATE(mat3)
      DEALLOCATE(ifabor)
      DEALLOCATE(nvois)
      DEALLOCATE(iadr)
!
!-----------------------------------------------------------------------
!
      RETURN
      END