auto_node_merge.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	auto_node_merge (is_dyna, numnusr, numcnod, numnod, itab, x)

Function/Subroutine Documentation

auto_node_merge()

subroutine auto_node_merge	(	integer, intent(in)	is_dyna,
		integer, intent(in)	numnusr,
		integer, intent(in)	numcnod,
		integer, intent(out)	numnod,
		integer, dimension(numnusr+numcnod), intent(in)	itab,
		dimension(3,numnusr)	x )

Definition at line 32 of file auto_node_merge.F.

C-----------------------------------------------
      USE message_mod
C
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-----------------------------------------------
      INTEGER,INTENT(IN) :: IS_DYNA
      INTEGER,INTENT(IN) :: NUMNUSR, NUMCNOD
      INTEGER,INTENT(OUT) :: NUMNOD
      INTEGER,INTENT(IN),DIMENSION(NUMNUSR+NUMCNOD)    :: ITAB
      my_real, INTENT(IN),DIMENSION(3,NUMNUSR) :: x
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, IREF, STAT
      INTEGER WORK(70000)
      INTEGER, DIMENSION(:), ALLOCATABLE :: ITABM1, INDX
      my_real :: xodusr, xmin, ymin, zmin, xmax, ymax, zmax, dx, dy, dz, tol
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      ALLOCATE (itabm1(2*(numnusr+numcnod)),indx(2*(numnusr+numcnod)),stat=stat)
      IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
     .                           msgtype=msgerror,
     .                         c1='ITABM1')
C-----------------------------------------------
C     Possibly Merge Nodes
      DO i = 1, numnusr
        indx(i) = i
      END DO
      
      CALL my_orders(0,work,itab,indx,numnusr,1)
      
      IF(numnusr>=1)THEN
        itabm1(1)         = itab(indx(1))
        itabm1(numnusr+1) = indx(1)
      ENDIF
      
      IF(is_dyna == 0)THEN
      
        DO i = 2, numnusr
          itabm1(i) = itab(indx(i))
          IF(itabm1(i)==itabm1(i-1))THEN
            CALL ancmsg(msgid=56,
     .                  msgtype=msgerror,
     .                  anmode=aninfo,
     .                  i1=itabm1(i))
          END IF
          itabm1(numnusr+i) = indx(i)
        END DO
        numnod = numnusr
 
      ELSE ! IF(IS_DYNA == 0)THEN
 
        xodusr=numnusr
        xmin =  ep20
        xmax = -ep20
        ymin =  ep20
        ymax = -ep20
        zmin =  ep20
        zmax = -ep20
        DO i = 1, numnusr
          xmin = min(xmin,x(1,i))       
          xmax = max(xmax,x(1,i))       
          ymin = min(ymin,x(2,i))       
          ymax = max(ymax,x(2,i))       
          zmin = min(zmin,x(3,i))       
          zmax = max(zmax,x(3,i))       
        END DO
        dx  = xmax-xmin
        dy  = ymax-ymin
        dz  = zmax-zmin
        tol = em05*(dx+dy+dz)/(three*exp(third*log(xodusr)))
 
        i = 2
        DO WHILE(i <= numnusr)
 
          itabm1(i) = itab(indx(i))
 
          iref = i-1
          xmin = x(1,indx(iref))       
          xmax = x(1,indx(iref))       
          ymin = x(2,indx(iref))       
          ymax = x(2,indx(iref))       
          zmin = x(3,indx(iref))       
          zmax = x(3,indx(iref))       
         
          DO WHILE(i <= numnusr .AND. itabm1(i)==itabm1(iref))
 
            xmin = min(xmin,x(1,indx(i)))       
            xmax = max(xmax,x(1,indx(i)))       
            ymin = min(ymin,x(2,indx(i)))       
            ymax = max(ymax,x(2,indx(i)))       
            zmin = min(zmin,x(3,indx(i)))       
            zmax = max(zmax,x(3,indx(i)))       
            
            indx(i)           = indx(iref) ! Possibly merging a cnode and a node, or 2 cnodes
            itabm1(numnusr+i) = indx(iref)
 
            i = i + 1
            itabm1(i)=itab(indx(i))
 
          END DO
          
          IF(i > iref+1)THEN
 
            dx = xmax-xmin
            dy = ymax-ymin
            dz = zmax-zmin
            IF(dx < tol .AND. dy < tol .AND. dz < tol)THEN
              CALL ancmsg(msgid=1891,
     .                    msgtype=msgwarning,
     .                    anmode=aninfo_blind_1,
     .                    i1=itabm1(i-1),i2=i-iref,i3=itabm1(i-1),r1=tol)
            ELSE
              CALL ancmsg(msgid=56,
     .                    msgtype=msgerror,
     .                    anmode=aninfo,
     .                    i1=itabm1(i-1))
            END IF
 
          ELSE ! IF(I > IREF+1)THEN
 
            itabm1(numnusr+i) = indx(i)
            i = i + 1
 
          END IF
 
        END DO ! DO WHILE(I <= NUMNUSR)
 
        numnod = 1
        DO i=2,numnusr
           IF(itabm1(numnusr+i) == itabm1(numnusr+i-1)) cycle ! Twice the same ID
           numnod = numnod + 1
        ENDDO
 
      END IF ! IF(IS_DYNA == 0)THEN
C-----------------------------------------------
      DO i = 1, numnusr+numcnod
        indx(i) = i
      END DO
      
      CALL my_orders(0,work,itab,indx,numnusr+numcnod,1)
      
      IF(numnusr+numcnod>=1)THEN
        itabm1(1)                 = itab(indx(1))
        itabm1(numnusr+numcnod+1) = indx(1)
      ENDIF
      
      DO i = 2, numnusr+numcnod
        itabm1(i) = itab(indx(i))
        IF(itabm1(i)==itabm1(i-1))THEN
          IF((indx(i-1) < numnusr .AND. indx(i) > numnusr) .OR.
     .       (indx(i-1) > numnusr .AND. indx(i) < numnusr)) THEN
C           A Node and a Cnode have the same ID
            CALL ancmsg(msgid=1889,
     .                  msgtype=msgerror,
     .                  anmode=aninfo,
     .                  i1=itabm1(i))
          ELSEIF(indx(i-1) > numnusr .AND. indx(i) > numnusr)THEN
C           Two Cnode shave the same ID
            CALL ancmsg(msgid=1890,
     .                  msgtype=msgerror,
     .                  anmode=aninfo,
     .                  i1=itabm1(i))
          END IF
        END IF
        itabm1(numnusr+numcnod+i) = indx(i)
      END DO
C-----------------------------------------------
      numnod = numnod + numcnod
      DEALLOCATE(itabm1,indx)
      RETURN