actideactistr.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	actideactistr (set, nset, istartset, iendset, ialset, objectset, ipkon, iobject, ne, neinset, iponoel, inoel, nepar)

Function/Subroutine Documentation

actideactistr()

subroutine actideactistr	(	character*81, dimension(*)	set,
		integer	nset,
		integer, dimension(*)	istartset,
		integer, dimension(*)	iendset,
		integer, dimension(*)	ialset,
		character*81, dimension(4,*)	objectset,
		integer, dimension(*)	ipkon,
		integer	iobject,
		integer	ne,
		integer, dimension(*)	neinset,
		integer, dimension(*)	iponoel,
		integer, dimension(2,*)	inoel,
		integer	nepar
	)

!
!     deactivates the elements which are not adjacent to the nodes in
!     the STRESS objective function set
!
      implicit none
!
      character*81 objectset(4,*),set(*)
!
      integer i,j,k,nset,istartset(*),iendset(*),ialset(*),ipkon(*),
     &  iobject,ne,index,nelem,iponoel(*),inoel(2,*),neinset(*),
     &  nepar
!
!     determining the nodes set corresponding to the STRESS
!     objective function
!
      do i=1,nset
         if(objectset(3,iobject).eq.set(i)) exit
      enddo
!
      nepar=0
!
      if(i.le.nset) then
!
!        deactivate all elements
!
         do j=1,ne
            if(ipkon(j).lt.0) cycle
            ipkon(j)=-2-ipkon(j)
         enddo
!
!        reactivate the elements adjacent to the nodes in the
!        STRESS objective function set (the stress is extrapolated
!        to the nodes, therefore only those elements are needed to
!        which the nodes in the STRESS objective function belong)
!
         do j=istartset(i),iendset(i)
            if(ialset(j).gt.0) then
               index=iponoel(ialset(j))
               do
                  if(index.eq.0) exit 
                  nelem=inoel(1,index)
                  if(neinset(nelem).eq.0) then
                     ipkon(nelem)=-ipkon(nelem)-2
                     neinset(nelem)=1
                     nepar=nepar+1
                  endif
                  index=inoel(2,index)
               enddo
            else
               k=ialset(j-2)
               do
                  k=k-ialset(j)
                  if(k.ge.ialset(j-1)) exit
                  index=iponoel(ialset(k))
                  do
                     if(index.eq.0) exit 
                     nelem=inoel(1,index)
                     if(neinset(nelem).eq.0) then
                        ipkon(nelem)=-ipkon(nelem)-2
                        neinset(nelem)=1
                        nepar=nepar+1
                     endif
                     index=inoel(2,index)
                  enddo
               enddo
            endif
         enddo
      else
!
!        all elements are taken into account
!
         do i=1,ne
            if(ipkon(i).lt.0) cycle
            neinset(i)=1
            nepar=nepar+1
         enddo
      endif
!
      return