create_line_from_surface_ext.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	create_line_from_surface_ext (clause)

Function/Subroutine Documentation

create_line_from_surface_ext()

subroutine create_line_from_surface_ext

(

type (set_)

clause

)

Definition at line 29 of file create_line_from_surface_ext.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE my_alloc_mod
      USE message_mod
      USE setdef_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE (SET_) :: CLAUSE
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,K,J1,J2,SIZEMAX,NSEG,IEXT,NSEG_EDGE_EXT,
     .        NSEG_EDGE_ALL,NSEG_SURF,LINE_NENTITY
      INTEGER IWORK(70000),IPERM(4)
!
      DATA iperm /2,3,4,1/
!
      INTEGER , DIMENSION(:),ALLOCATABLE :: INDEX,IW1,IW2,IW5,IW6
      INTEGER , DIMENSION(:,:),ALLOCATABLE :: ITRI,LINE_ORD
C=======================================================================
      sizemax = clause%NB_LINE_SEG +  4*clause%NB_SURF_SEG
 
      IF (sizemax == 0) RETURN
 
!
      line_nentity = 4 ! NOD1, NOD2, ELTYP, ELEM
      ALLOCATE(line_ord(line_nentity,sizemax))
      ALLOCATE(itri(3,sizemax))
      ALLOCATE(index(2*sizemax))
!
      ALLOCATE(iw1(4*sizemax))
      ALLOCATE(iw2(4*sizemax))
      ALLOCATE(iw5(4*sizemax))
      ALLOCATE(iw6(4*sizemax))
!------------------
      ! NSEG of lines  initialization
      nseg = clause%NB_LINE_SEG  ! lines from 1D_element
!     Fill in LINE_ORD array the already stored line from 1D_element
      DO i=1,nseg
        line_ord(1,i) = clause%LINE_NODES(i,1)
        line_ord(2,i) = clause%LINE_NODES(i,2)
        line_ord(3,i) = clause%LINE_ELTYP(i)
        line_ord(4,i) = clause%LINE_ELEM(i)
      ENDDO
!
!     extract lines from furfaces
!
      nseg_surf = clause%NB_SURF_SEG
      IF (nseg_surf > 0) THEN
!***********************************
!***********************************
      ! -- EXT -- edges form SURFACE
!***********************************
!***********************************
        nseg_edge_ext = 0
!---
        k=0
        iw1 = 0
        iw2 = 0
        iw5 = 0
        iw6 = 0
        DO i=1,nseg_surf
          DO j1=1,4
            j2=iperm(j1)
            IF (clause%SURF_NODES(i,j2) /= 0 .AND.
     .          clause%SURF_NODES(i,j1) > clause%SURF_NODES(i,j2)) THEN
              k=k+1
              iw1(k)=clause%SURF_NODES(i,j2)
              iw2(k)=clause%SURF_NODES(i,j1)
              iw5(k)=clause%SURF_ELTYP(i)  
              iw6(k)=clause%SURF_ELEM(i)
            ELSEIF (clause%SURF_NODES(i,j1) /= 0 .AND.
     .              clause%SURF_NODES(i,j1) < clause%SURF_NODES(i,j2)) THEN
              k=k+1
              iw1(k)=clause%SURF_NODES(i,j1)
              iw2(k)=clause%SURF_NODES(i,j2)
              iw5(k)=clause%SURF_ELTYP(i)
              iw6(k)=clause%SURF_ELEM(i)
            ENDIF
          ENDDO
        ENDDO ! DO I=1,NSEG_SURF
!
        nseg_edge_ext = k
C-----------------------------------------------
        index = 0
        iwork(1:70000) = 0
        CALL my_orders( 0,iwork,iw1,index,k,1)
        iwork(1:70000) = 0
        CALL my_orders(10,iwork,iw2,index,k,1)   ! my_order(10 uses previous index
!---
        IF (nseg_edge_ext > 0) THEN
C-----------------------------------------------
C       REMOVE INTERNAL SEGMENTS (EXCEPT BOUNDARY)
C-----------------------------------------------
          IF (iw1(index(1)) /= iw1(index(2)).OR.
     .        iw2(index(1)) /= iw2(index(2)))THEN
            nseg=nseg+1
            line_ord(1,nseg) = iw1(index(1))
            line_ord(2,nseg) = iw2(index(1))
            line_ord(3,nseg) = iw5(index(1))
            line_ord(4,nseg) = iw6(index(1))
          ENDIF
          DO i=2,k-1
            IF ((iw1(index(i-1)) /= iw1(index(i)).OR.
     .           iw2(index(i-1)) /= iw2(index(i))).AND.
     .          (iw1(index(i+1)) /= iw1(index(i)).OR.
     .           iw2(index(i+1)) /= iw2(index(i)))) THEN
              nseg=nseg+1
              line_ord(1,nseg) = iw1(index(i))
              line_ord(2,nseg) = iw2(index(i))
              line_ord(3,nseg) = iw5(index(i))
              line_ord(4,nseg) = iw6(index(i))
            ENDIF
          ENDDO
          IF (iw1(index(k-1)) /= iw1(index(k)).OR.
     .        iw2(index(k-1)) /= iw2(index(k))) THEN
            nseg=nseg+1
            line_ord(1,nseg) = iw1(index(k))
            line_ord(2,nseg) = iw2(index(k))
            line_ord(3,nseg) = iw5(index(k))
            line_ord(4,nseg) = iw6(index(k))
          ENDIF
        ENDIF ! IF (NSEG_EDGE_EXT > 0)
      ENDIF ! IF (NSEG_SURF > 0)
!------------------------------------------
!------------------------------------------
!     ORDER LINES and LINE CLAUSE FILLING
!------------------------------------------
!------------------------------------------
      index = 0
      iwork(1:70000) = 0
      DO i=1,nseg
        index(i)=i
        itri(1,i) = line_ord(1,i)
        itri(2,i) = line_ord(2,i)
        itri(3,i) = line_ord(4,i) ! elem_id
      ENDDO
      CALL my_orders(0,iwork,itri,index,nseg,3)
!
      ! reallocation of the line CLAUSE at the right dimension and final fill
!
      IF (ALLOCATED(clause%LINE_NODES)) DEALLOCATE(clause%LINE_NODES)
      IF (ALLOCATED(clause%LINE_ELTYP)) DEALLOCATE(clause%LINE_ELTYP)
      IF (ALLOCATED(clause%LINE_ELEM))  DEALLOCATE(clause%LINE_ELEM)
!
      clause%NB_LINE_SEG = nseg
      CALL my_alloc(clause%LINE_NODES,nseg,2)
      CALL my_alloc(clause%LINE_ELTYP,nseg)
      CALL my_alloc(clause%LINE_ELEM,nseg)
!
      DO i=1,nseg
        clause%LINE_NODES(i,1) = line_ord(1,index(i))
        clause%LINE_NODES(i,2) = line_ord(2,index(i))
        clause%LINE_ELTYP(i)   = line_ord(3,index(i))
        clause%LINE_ELEM(i)    = line_ord(4,index(i))
      ENDDO
!---
      IF (ALLOCATED(line_ord))  DEALLOCATE(line_ord)
      IF (ALLOCATED(itri))  DEALLOCATE(itri)
      IF (ALLOCATED(index)) DEALLOCATE(index)
      IF (ALLOCATED(iw1))   DEALLOCATE(iw1)
      IF (ALLOCATED(iw2))   DEALLOCATE(iw2)
      IF (ALLOCATED(iw5))   DEALLOCATE(iw5)
      IF (ALLOCATED(iw6))   DEALLOCATE(iw6)
C-----------
      RETURN