mafillsmforc.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	mafillsmforc (nforc, ndirforc, nodeforc, xforc, nactdof, fext, nmpc, ipompc, nodempc, ikmpc, ilmpc, coefmpc, mi, rhsi, fnext, nmethod)

Function/Subroutine Documentation

mafillsmforc()

subroutine mafillsmforc	(	integer	nforc,
		integer, dimension(*)	ndirforc,
		integer, dimension(2,*)	nodeforc,
		real*8, dimension(*)	xforc,
		integer, dimension(0:mi(2),*)	nactdof,
		real*8, dimension(*)	fext,
		integer	nmpc,
		integer, dimension(*)	ipompc,
		integer, dimension(3,*)	nodempc,
		integer, dimension(*)	ikmpc,
		integer, dimension(*)	ilmpc,
		real*8, dimension(*)	coefmpc,
		integer, dimension(*)	mi,
		logical	rhsi,
		real*8, dimension(0:mi(2),*)	fnext,
		integer	nmethod
	)

!
!     including point forces into the external force vector
!
      implicit none
!
      logical rhsi
!
      integer nforc,ndirforc(*),nodeforc(2,*),mi(*),nactdof(0:mi(2),*),
     &  nmpc,ipompc(*),nodempc(3,*),ikmpc(*),ilmpc(*),i,jdof,id,ist,
     &  index,nmethod
!
      real*8 xforc(*),fext(*),coefmpc(*),fnext(0:mi(2),*)
!
      if(rhsi) then
!
!        point forces
!      
         do i=1,nforc
            if(ndirforc(i).gt.mi(2)) cycle
c            if(ndirforc(i).gt.3) cycle
!
!           updating the external force vector for dynamic
!           calculations
!
            if(nmethod.eq.4) fnext(ndirforc(i),nodeforc(1,i))=
     &                       fnext(ndirforc(i),nodeforc(1,i))+xforc(i)
!
            jdof=nactdof(ndirforc(i),nodeforc(1,i))
            if(jdof.gt.0) then
               fext(jdof)=fext(jdof)+xforc(i)
            else
!
!              node is a dependent node of a MPC: distribute
!              the forces among the independent nodes
!              (proportional to their coefficients)
!
c               jdof=8*(nodeforc(1,i)-1)+ndirforc(i)
c               call nident(ikmpc,jdof,nmpc,id)
c               if(id.gt.0) then
c                  if(ikmpc(id).eq.jdof) then
               if(jdof.ne.2*(jdof/2)) then
c                     id=ilmpc(id)
                     id=(-jdof+1)/2
                     ist=ipompc(id)
                     index=nodempc(3,ist)
                     if(index.eq.0) cycle
                     do
                        jdof=nactdof(nodempc(2,index),nodempc(1,index))
                        if(jdof.gt.0) then
                           fext(jdof)=fext(jdof)-
     &                          coefmpc(index)*xforc(i)/coefmpc(ist)
                        endif
                        index=nodempc(3,index)
                        if(index.eq.0) exit
                     enddo
c                  endif
               endif
            endif
         enddo
!
      endif
!
      return