formgradinterpol.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	formgradinterpol (ipkon, lakon, kon, nobject, dgdxglob, xinterpol, nnodes, ne, nk, nodedesiinv, objectset)

Function/Subroutine Documentation

formgradinterpol()

subroutine formgradinterpol	(	integer, dimension(*)	ipkon,
		character*8, dimension(*)	lakon,
		integer, dimension(*)	kon,
		integer	nobject,
		real*8, dimension(2,nk,nobject)	dgdxglob,
		real*8, dimension(nk,nobject)	xinterpol,
		integer, dimension(nk)	nnodes,
		integer	ne,
		integer	nk,
		integer, dimension(nk)	nodedesiinv,
		character*81, dimension(4,*)	objectset
	)

!
!     interpolation of the sensitivitites of the midnodes to the 
!     corner nodes - only valid for quadratic elements
!
      implicit none
!
      character*81 objectset(4,*)
      character*8 lakon(*)
!
      integer i,ii,j,l,ielem,nodecor,nk,ne,
     &   nope,indexe,ipkon(*),konl(26),ifaceq(2,20),
     &   ifacet(2,10),ifacew(2,15),kon(*),nnodes(nk),nobject,
     &   nodedesiinv(nk),start
!
      real*8 dgdxglob(2,nk,nobject),xinterpol(nk,nobject)
!
!     cornernodes next to the midnode for quadratic hex element
!
      data ifaceq /0,0,
     &             0,0,
     &             0,0,
     &             0,0,
     &             0,0,
     &             0,0,
     &             0,0,
     &             0,0,
     &             1,2,
     &             2,3,
     &             3,4,
     &             1,4,
     &             5,6,
     &             6,7,
     &             7,8,
     &             5,8,
     &             1,5,
     &             2,6,
     &             3,7,
     &             4,8/
!
!     cornernodes next to the midnode for quadratic tet elements
!
      data ifacet /0,0,
     &             0,0,
     &             0,0,
     &             0,0,
     &             1,2,
     &             2,3,
     &             1,3,
     &             1,4,
     &             2,4,
     &             3,4/
!
!     cornernodes next to the midnode for quadratic wedge elements
!
      data ifacew /0,0,
     &             0,0,
     &             0,0,
     &             0,0,
     &             0,0,
     &             0,0,
     &             1,2,
     &             2,3,
     &             1,3,
     &             4,5,
     &             5,6,
     &             4,6,
     &             1,4,
     &             2,5,
     &             3,6/
!
!     Loop over all elements
!
      do ielem=1,ne         
!
         if(ipkon(ielem).lt.0) cycle
!
!        Check if element is quadratic
!     
         if(lakon(ielem)(4:5).eq.'10') then
            nope=10
            start=5
         elseif(lakon(ielem)(4:5).eq.'20') then
            nope=20
            start=9
         elseif (lakon(ielem)(4:5).eq.'15') then  
            nope=15
            start=7      
         else 
            cycle
         endif
         
         indexe=ipkon(ielem)        
!     
         do l=1,nope
            konl(l)=kon(indexe+l)
         enddo
!     
!        Loop over all midnodes of the element
!     
         do i=start,nope
!     
            if(nodedesiinv(konl(i)).le.0) cycle
!     
!           Loop over the 2 neighbors of the midnode
!
            do j=1,2
               if(lakon(ielem)(4:5).eq.'10') then
                  nodecor=konl(ifacet(j,i))
               elseif (lakon(ielem)(4:5).eq.'20') then
                  nodecor=konl(ifaceq(j,i))
               elseif (lakon(ielem)(4:5).eq.'15') then
                  nodecor=konl(ifacew(j,i))
               endif
               if(nodedesiinv(nodecor).eq.1) then
                  nnodes(nodecor)=nnodes(nodecor)+1        
                  do ii=1,nobject
                     xinterpol(nodecor,ii)=xinterpol(nodecor,ii)+
     &                    dgdxglob(1,konl(i),ii)
                  enddo
               endif
            enddo
            nodedesiinv(konl(i))=-1
         enddo
      enddo
!     
      do i=1,nk
         if(nnodes(i).gt.0) then
            do j=1,nobject
               if(objectset(1,j)(1:9).eq.'THICKNESS') cycle      
               dgdxglob(1,i,j)=xinterpol(i,j)/nnodes(i)
            enddo
         endif
      enddo  
!
!     Correction of nodedesiinv
!
      do i=1,nk
         if(nodedesiinv(i).eq.-1) then
            nodedesiinv(i)=1
         endif
      enddo
!     
      return