make_eltcar.f

Go to the documentation of this file.

!                   **********************
                    SUBROUTINE make_eltcar
!                   **********************
!
     &(eltcar,ifac,
     & ikle,npoin2,nelem2,nelmax,knolg,iscore,mesh,nplan,ielm)
!
!***********************************************************************
! BIEF   V7P1
!***********************************************************************
!
!brief    For every point in the mesh, gives an element that contains
!+        this point. This element must be the same in scalar and in
!+        parallel mode, ELTCAR(I)=0 means that the element is in another
!+        sub-domain.
!+        A byproduct is array IFAC, for every point it is 1, except
!+        on boundaries between sub-domains, where it is 0 for all
!+        sub-domain but 1.
!
!note     In every triangle a point is followed by another one:
!+        2 follows 1, 3 follows 2, 1 follows 3
!+        A point cannot be followed by the same point in 2 different
!+        triangles (if all triangles are counterclock-wise oriented).
!+        For every point we choose the element where the next point
!+        has the higher rank.
!+        With quadratic interpolation, the next linear point is taken
!+        2 follows 4, 3 follows 5, 1 follows 6
!+        The case of quasi-bubble is obvious and not treated here: the
!+        point is in the middle of an element, so no problem of choice
!+
!+        Choosing the element with highest number would be easier but
!+        there is so far nothing like KNOLG for elements...
!
!history  C. DENIS (SINETICS, EDF R&D), J-M HERVOUET (LNHE, EDF R&D)
!+        27/04/2012
!+        V6P2
!+
!
!history  J-M HERVOUET (LNHE, EDF R&D)
!+        14/06/2012
!+        V6P2
!+        Prisms cut into tetrahedra added, quasi-bubble completed
!
!history  J-M HERVOUET (LNHE, EDF R&D)
!+        21/09/2012
!+        V6P3
!+        Correction of IELEM3D in tetrahedra part (1st use 1st bug...)
!
!history  J-M HERVOUET (LNHE, EDF R&D)
!+        20/11/2013
!+        V7P0
!+        Call of PARCOM2I and PARCOM2I_SEG added for ISCORE, instead of
!+        copying to a double precision SCORE (the latter suppressed).
!
!history  J-M HERVOUET (LNHE, EDF LAB)
!+        10/06/2015
!+        V7P1
!+        Array IFAC built, based on ELTCAR. This is for dot product.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| ELTCAR         |<--| ELEMENT CHOSEN FOR EVERY POINT
!| IELM           |-->| TYPE OF ELEMENT (11: TRIANGLE, 41: PRISM...)
!| IKLE           |-->| CONNECTIVITY TABLE
!| ISCORE         |<->| INTEGER WORK ARRAY
!| KNOLG          |-->| GLOBAL NUMBER OF POINTS IN ORIGINAL MESH
!| MESH           |-->| MESH STRUCTURE
!| NELEM2         |-->| NUMBER OF ELEMENTS IN 2D MESH
!| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
!| NPLAN          |-->| NUMBER OF PLANES (CASE OF A 3D MESH, OR 1 IN 2D)
!| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief_def
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN)             :: NPOIN2,NELEM2,NELMAX,NPLAN,IELM
      INTEGER, INTENT(IN)             :: IKLE(nelmax,*),KNOLG(*)
      INTEGER, INTENT(INOUT)          :: ELTCAR(*),IFAC(*)
      INTEGER, INTENT(INOUT)          :: ISCORE(*)
      TYPE(bief_mesh), INTENT(INOUT)  :: MESH
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER I,IELEM,N1,N2,N3,N4,N5,N6,IPLAN,NP,I3D,K,IELEM3D
!
      IF(ielm.EQ.11.OR.ielm.EQ.12.OR.ielm.EQ.41.OR.ielm.EQ.51) THEN
        np=npoin2
      ELSEIF(ielm.EQ.13) THEN
        np=npoin2+mesh%NSEG
      ELSE
        WRITE(lu,*) 'MAKE_ELTCAR NOT PROGRAMMED FOR IELM=',ielm
        CALL plante(1)
        stop
      ENDIF
!
      DO i=1,np
        iscore(i)=0
      ENDDO
!
      IF(ncsize.LE.1) THEN
!
!       SIMPLE CASE: SCALAR MODE
!
        IF(ielm.EQ.11.OR.ielm.EQ.12.OR.ielm.EQ.41.OR.ielm.EQ.51) THEN
!
          DO ielem = 1,nelem2
            n1=ikle(ielem,1)
            n2=ikle(ielem,2)
            n3=ikle(ielem,3)
            IF(iscore(n1).LT.n2) THEN
              iscore(n1)=n2
              eltcar(n1)=ielem
            ENDIF
            IF(iscore(n2).LT.n3) THEN
              iscore(n2)=n3
              eltcar(n2)=ielem
            ENDIF
            IF(iscore(n3).LT.n1) THEN
              iscore(n3)=n1
              eltcar(n3)=ielem
            ENDIF
          ENDDO
!
        ELSEIF(ielm.EQ.13) THEN
!
          DO ielem = 1,nelem2
            n1=ikle(ielem,1)
            n2=ikle(ielem,2)
            n3=ikle(ielem,3)
            n4=ikle(ielem,4)
            n5=ikle(ielem,5)
            n6=ikle(ielem,6)
            IF(iscore(n1).LT.n2) THEN
              iscore(n1)=n2
              eltcar(n1)=ielem
            ENDIF
            IF(iscore(n2).LT.n3) THEN
              iscore(n2)=n3
              eltcar(n2)=ielem
            ENDIF
            IF(iscore(n3).LT.n1) THEN
              iscore(n3)=n1
              eltcar(n3)=ielem
            ENDIF
            IF(iscore(n4).LT.n2) THEN
              iscore(n4)=n2
              eltcar(n4)=ielem
            ENDIF
            IF(iscore(n5).LT.n3) THEN
              iscore(n5)=n3
              eltcar(n5)=ielem
            ENDIF
            IF(iscore(n6).LT.n1) THEN
              iscore(n6)=n1
              eltcar(n6)=ielem
            ENDIF
          ENDDO
!
        ENDIF
!
      ELSE
!
!       NOW IN PARALLEL, FIRST LIKE IN SCALAR BUT WITH GLOBAL NUMBERS
!
        IF(ielm.EQ.11.OR.ielm.EQ.12.OR.ielm.EQ.41.OR.ielm.EQ.51) THEN
!
          DO ielem = 1,nelem2
            n1=ikle(ielem,1)
            n2=ikle(ielem,2)
            n3=ikle(ielem,3)
            IF(iscore(n1).LT.knolg(n2)) THEN
              iscore(n1)=knolg(n2)
              eltcar(n1)=ielem
            ENDIF
            IF(iscore(n2).LT.knolg(n3)) THEN
              iscore(n2)=knolg(n3)
              eltcar(n2)=ielem
            ENDIF
            IF(iscore(n3).LT.knolg(n1)) THEN
              iscore(n3)=knolg(n1)
              eltcar(n3)=ielem
            ENDIF
          ENDDO
!
        ELSEIF(ielm.EQ.13) THEN
!
          DO ielem = 1,nelem2
            n1=ikle(ielem,1)
            n2=ikle(ielem,2)
            n3=ikle(ielem,3)
            n4=ikle(ielem,4)
            n5=ikle(ielem,5)
            n6=ikle(ielem,6)
            IF(iscore(n1).LT.knolg(n2)) THEN
              iscore(n1)=knolg(n2)
              eltcar(n1)=ielem
            ENDIF
            IF(iscore(n2).LT.knolg(n3)) THEN
              iscore(n2)=knolg(n3)
              eltcar(n2)=ielem
            ENDIF
            IF(iscore(n3).LT.knolg(n1)) THEN
              iscore(n3)=knolg(n1)
              eltcar(n3)=ielem
            ENDIF
            IF(iscore(n4).LT.knolg(n2)) THEN
              iscore(n4)=knolg(n2)
              eltcar(n4)=ielem
            ENDIF
            IF(iscore(n5).LT.knolg(n3)) THEN
              iscore(n5)=knolg(n3)
              eltcar(n5)=ielem
            ENDIF
            IF(iscore(n6).LT.knolg(n1)) THEN
              iscore(n6)=knolg(n1)
              eltcar(n6)=ielem
            ENDIF
          ENDDO
!
        ENDIF
!
!       LARGEST VALUE BETWEEN NEIGHBOURING SUB-DOMAINS TAKEN
        CALL parcom2i(iscore,iscore,iscore,npoin2,1,1,1,mesh)
        IF(ielm.EQ.13) THEN
          CALL parcom2i_seg(iscore(npoin2+1:np),
     &                      iscore(npoin2+1:np),
     &                      iscore(npoin2+1:np),
     &                      mesh%NSEG,1,1,1,mesh,1,11)
        ENDIF
!
        IF(ielm.EQ.11.OR.ielm.EQ.12.OR.ielm.EQ.41.OR.ielm.EQ.51) THEN
!
          DO ielem = 1,nelem2
            n1=ikle(ielem,1)
            n2=ikle(ielem,2)
            n3=ikle(ielem,3)
            IF(iscore(n1).EQ.knolg(n2)) THEN
!             THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
              iscore(n1)=0
            ENDIF
            IF(iscore(n2).EQ.knolg(n3)) THEN
!             THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
              iscore(n2)=0
            ENDIF
            IF(iscore(n3).EQ.knolg(n1)) THEN
!             THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
              iscore(n3)=0
            ENDIF
          ENDDO
!
        ELSEIF(ielm.EQ.13) THEN
!
          DO ielem = 1,nelem2
            n1=ikle(ielem,1)
            n2=ikle(ielem,2)
            n3=ikle(ielem,3)
            n4=ikle(ielem,4)
            n5=ikle(ielem,5)
            n6=ikle(ielem,6)
            IF(iscore(n1).EQ.knolg(n2)) THEN
!             THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
              iscore(n1)=0
            ENDIF
            IF(iscore(n2).EQ.knolg(n3)) THEN
!             THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
              iscore(n2)=0
            ENDIF
            IF(iscore(n3).EQ.knolg(n1)) THEN
!             THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
              iscore(n3)=0
            ENDIF
            IF(iscore(n4).EQ.knolg(n2)) THEN
!             THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
              iscore(n4)=0
            ENDIF
            IF(iscore(n5).EQ.knolg(n3)) THEN
!             THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
              iscore(n5)=0
            ENDIF
            IF(iscore(n6).EQ.knolg(n1)) THEN
!             THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
              iscore(n6)=0
            ENDIF
          ENDDO
!
        ENDIF
!
!       IF A POINT HAS A BETTER ELEMENT IN ANOTHER SUB-DOMAIN
        DO i=1,np
          IF(iscore(i).NE.0) THEN
            eltcar(i)=0
          ENDIF
        ENDDO
!
      ENDIF
!
!-----------------------------------------------------------------------
!
!     NOW DEDUCING IFAC
!
      IF(ncsize.GT.1) THEN
        DO i=1,np
          IF(eltcar(i).NE.0) THEN
            ifac(i)=1
          ELSE
            ifac(i)=0
          ENDIF
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!
!     COMPLETING FOR QUASI-BUBBLE
!
      IF(ielm.EQ.12) THEN
        DO ielem=1,nelem2
          eltcar(npoin2+ielem)=ielem
        ENDDO
      ENDIF
      IF(ncsize.GT.1.AND.ielm.EQ.12) THEN
        DO ielem=1,nelem2
          ifac(npoin2+ielem)=1
        ENDDO
      ENDIF
!
!     COMPLETING FOR 3D PRISMS
!
      IF(nplan.GT.1) THEN
        IF(ielm.EQ.41) THEN
          DO iplan=2,nplan
            DO i=1,npoin2
!             ACCORDING TO POINT AND ELEMENT NUMBERING IN PRISMS
              i3d=i+(iplan-1)*npoin2
              IF(eltcar(i).GT.0) THEN
                eltcar(i3d)=eltcar(i)+(iplan-1)*nelem2
              ELSE
                eltcar(i3d)=0
              ENDIF
            ENDDO
          ENDDO
        ELSEIF(ielm.EQ.51) THEN
          DO iplan=2,nplan
            DO i=1,npoin2
              i3d=i+(iplan-1)*npoin2
              IF(eltcar(i).GT.0) THEN
!               3 TETRAHEDRA POSSIBLE CANDIDATES
                DO k=1,3
!                 SEE ELEMENT NUMBERING IN PRISMS CUT INTO TETRAHEDRA
                  ielem3d=(iplan-2)*3*nelem2+(k-1)*nelem2+eltcar(i)
!                 THIS MAY HIT SEVERAL TIMES AS A POINT MAY BELONG
!                 TO MORE THAN ONE TETRAHEDRON AT THIS LEVEL,
!                 THE LAST HIT IS KEPT, SAME BEHAVIOUR IN SCALAR OR
!                 PARALLEL. NOT VERY ELEGANT, BETTER IDEA ?
                  IF(ikle(ielem3d,1).EQ.i3d) THEN
                    eltcar(i3d)=ielem3d
                  ELSEIF(ikle(ielem3d,2).EQ.i3d) THEN
                    eltcar(i3d)=ielem3d
                  ELSEIF(ikle(ielem3d,3).EQ.i3d) THEN
                    eltcar(i3d)=ielem3d
                  ELSEIF(ikle(ielem3d,4).EQ.i3d) THEN
                    eltcar(i3d)=ielem3d
                  ENDIF
                ENDDO
              ELSE
                eltcar(i3d)=0
              ENDIF
            ENDDO
          ENDDO
        ENDIF
!
!       COMPLETING IFAC FOR PRISMS OR PRISMS CUT INTO TETRAHEDRA
!
        IF(ncsize.GT.1) THEN
          DO iplan=2,nplan
            DO i=1,npoin2
!             ACCORDING TO POINT AND ELEMENT NUMBERING IN PRISMS
              ifac(i+(iplan-1)*npoin2)=ifac(i)
            ENDDO
          ENDDO
        ENDIF
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END