admordr.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"
#include "param_c.inc"
#include "parit_c.inc"
#include "remesh_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	admordr (sh4tree, sh3tree, ixc, ixtg)

Function/Subroutine Documentation

admordr()

subroutine admordr	(	integer, dimension(ksh4tree,*)	sh4tree,
		integer, dimension(ksh3tree,*)	sh3tree,
		integer, dimension(nixc,*)	ixc,
		integer, dimension(nixtg,*)	ixtg )

Definition at line 34 of file admordr.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE remesh_mod
      USE my_alloc_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
#include      "parit_c.inc"
#include      "remesh_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*),
     .        IXC(NIXC,*), IXTG(NIXTG,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER N,NN,LEVEL,IP,NLEV,PTR,SON,
     .        J,NI,IERR
      INTEGER,DIMENSION(:),ALLOCATABLE :: LTMP4
      INTEGER,DIMENSION(:),ALLOCATABLE :: LTMP3
      INTEGER,DIMENSION(:),ALLOCATABLE :: ITRI
      INTEGER,DIMENSION(:),ALLOCATABLE :: SORT_INDEX
      INTEGER WORK(70000)
C-----------------------------------------------
      CALL my_alloc(ltmp4,nsh4act)
      CALL my_alloc(ltmp3,nsh3act)
      CALL my_alloc(itri,max(nsh4act,nsh3act))
      CALL my_alloc(sort_index,2*max(nsh4act,nsh3act))
C-----------------------------------------------
      IF(iparit/=0)THEN
 
        DO nn = 1, nsh4act
          itri(nn) = ixc(nixc,lsh4act(nn))
        ENDDO
        CALL my_orders(0,work,itri,sort_index,nsh4act,1)
        ltmp4(1:nsh4act)=lsh4act(1:nsh4act)
        DO nn = 1, nsh4act
          lsh4act(nn)=ltmp4(sort_index(nn))
        END DO
 
        DO nn = 1, nsh3act
          itri(nn) = ixtg(nixtg,lsh3act(nn))
        ENDDO
        CALL my_orders(0,work,itri,sort_index,nsh3act,1)
        ltmp3(1:nsh3act)=lsh3act(1:nsh3act)
        DO nn = 1, nsh3act
          lsh3act(nn)=ltmp3(sort_index(nn))
        END DO
 
      END IF
    
      psh4act=0
 
      DO nn=1,nsh4act
        n    =lsh4act(nn)
        level=sh4tree(3,n)
        psh4act(level)=psh4act(level)+1
        ltmp4(nn)=n
      END DO 
C
      DO level=1,levelmax
        psh4act(level)=psh4act(level)+psh4act(level-1)
      END DO
C
      DO level=levelmax+1,1,-1
        psh4act(level)=psh4act(level-1)
      END DO
      psh4act(0)=0
C
      DO nn=1,nsh4act
        n    =ltmp4(nn)
        level=sh4tree(3,n)
        psh4act(level)=psh4act(level)+1
        lsh4act(psh4act(level))=n
      END DO
C
      DO level=levelmax+1,1,-1
        psh4act(level)=psh4act(level-1)
      END DO
      psh4act(0)=0
C
      psh4kin(0)=0
      lsh4kin(1:psh4act(1))=lsh4act(1:psh4act(1))
 
      ptr = psh4act(1)
      DO level=0,levelmax-1
        psh4kin(level+1)=ptr
        DO nn=psh4kin(level)+1,psh4kin(level+1)
          n    =lsh4kin(nn)
          son=sh4tree(2,n)
          ptr=ptr+1
          lsh4kin(ptr)=son
          ptr=ptr+1
          lsh4kin(ptr)=son+1
          ptr=ptr+1
          lsh4kin(ptr)=son+2
          ptr=ptr+1
          lsh4kin(ptr)=son+3
        END DO
        DO nn=psh4act(level+1)+1,psh4act(level+2)
          ptr=ptr+1
          lsh4kin(ptr)=lsh4act(nn)
        END DO
      END DO
      psh4kin(levelmax+1)=ptr
 
C--------------------------------------------
C     TRIANGLES
C--------------------------------------------
      psh3act=0
 
      DO nn=1,nsh3act
        n    =lsh3act(nn)
        level=sh3tree(3,n)
        psh3act(level)=psh3act(level)+1
        ltmp3(nn)=n
      END DO 
C
      DO level=1,levelmax
        psh3act(level)=psh3act(level)+psh3act(level-1)
      END DO
C
      DO level=levelmax+1,1,-1
        psh3act(level)=psh3act(level-1)
      END DO
      psh3act(0)=0
C
      DO nn=1,nsh3act
        n    =ltmp3(nn)
        level=sh3tree(3,n)
        psh3act(level)=psh3act(level)+1
        lsh3act(psh3act(level))=n
      END DO
C
      DO level=levelmax+1,1,-1
        psh3act(level)=psh3act(level-1)
      END DO
      psh3act(0)=0
C
      psh3kin(0)=0
      lsh3kin(1:psh3act(1))=lsh3act(1:psh3act(1))
 
      ptr = psh3act(1)
      DO level=0,levelmax-1
        psh3kin(level+1)=ptr
        DO nn=psh3kin(level)+1,psh3kin(level+1)
          n    =lsh3kin(nn)
          son=sh3tree(2,n)
          ptr=ptr+1
          lsh3kin(ptr)=son
          ptr=ptr+1
          lsh3kin(ptr)=son+1
          ptr=ptr+1
          lsh3kin(ptr)=son+2
          ptr=ptr+1
          lsh3kin(ptr)=son+3
        END DO
        DO nn=psh3act(level+1)+1,psh3act(level+2)
          ptr=ptr+1
          lsh3kin(ptr)=lsh3act(nn)
        END DO
      END DO
      psh3kin(levelmax+1)=ptr
C--------------------------------------------
      DEALLOCATE(ltmp4)
      DEALLOCATE(ltmp3)
      DEALLOCATE(itri)
      DEALLOCATE(sort_index)
 
      RETURN