resultsforc_em.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	resultsforc_em (nk, f, fn, nactdof, ipompc, nodempc, coefmpc, labmpc, nmpc, mi, fmpc, calcul_fn, calcul_f, inomat)

Function/Subroutine Documentation

resultsforc_em()

subroutine resultsforc_em	(	integer	nk,
		real*8, dimension(*)	f,
		real*8, dimension(0:mi(2),*)	fn,
		integer, dimension(0:mi(2),*)	nactdof,
		integer, dimension(*)	ipompc,
		integer, dimension(3,*)	nodempc,
		real*8, dimension(*)	coefmpc,
		character*20, dimension(*)	labmpc,
		integer	nmpc,
		integer, dimension(*)	mi,
		real*8, dimension(*)	fmpc,
		integer	calcul_fn,
		integer	calcul_f,
		integer, dimension(*)	inomat
	)

!
!     calculating the equation system internal force vector
!     (one entry for each active degree of freedom)
!
!     This routine is based on resultsforc. Whereas resultsforc
!     applies to mechanical and thermal degrees of freedom,
!     resultsforcem is limited to thermal degrees of freedom.
!     (application for electromagnetic calculations)
!
      implicit none
!
      character*20 labmpc(*)
!
      integer mi(*),nactdof(0:mi(2),*),ipompc(*),nodempc(3,*),nk,i,j,
     &  nmpc,ist,ndir,node,index,calcul_fn,calcul_f,inomat(*)
!
      real*8 f(*),fn(0:mi(2),*),coefmpc(*),fmpc(*),forcempc
!
!     subtracting the mpc force (for each linear mpc there is one
!     force; the actual force in a node belonging to the mpc is
!     obtained by multiplying this force with the nodal coefficient.
!     The force has to be subtracted from f, since it does not
!     appear on the rhs of the equation system
!
      if(calcul_fn.eq.1)then
        do i=1,nmpc
            ist=ipompc(i)
            node=nodempc(1,ist)
            if(inomat(node).eq.0) cycle
            ndir=nodempc(2,ist)
c            if(ndir.ne.0) cycle
            forcempc=fn(ndir,node)/coefmpc(ist)
            fmpc(i)=forcempc
            fn(ndir,node)=0.d0
            index=nodempc(3,ist)
            if(index.eq.0) cycle
            do
               node=nodempc(1,index)
               ndir=nodempc(2,index)
               fn(ndir,node)=fn(ndir,node)-coefmpc(index)*forcempc
               index=nodempc(3,index)
               if(index.eq.0) exit
            enddo
         enddo
      endif
!
!     calculating the system force vector
!
      if(calcul_f.eq.1) then
         do i=1,nk
            if(inomat(i).eq.0) cycle
            if(nactdof(0,i).gt.0) then
               f(nactdof(0,i))=fn(0,i)
            endif
c            do j=0,mi(2)
c               if(nactdof(j,i).ne.0) then
c                  f(nactdof(j,i))=fn(j,i)
c               endif
c            enddo
         enddo
      endif
!
!     adding the mpc force again to fn
!
      if(calcul_fn.eq.1)then
         do i=1,nmpc
            ist=ipompc(i)
            node=nodempc(1,ist)
            if(inomat(node).eq.0) cycle
            ndir=nodempc(2,ist)
c            if(ndir.ne.0) cycle
            forcempc=fmpc(i)
            fn(ndir,node)=forcempc*coefmpc(ist)
            index=nodempc(3,ist)
!
!           nodes not belonging to the structure have to be
!           taken out
!
            if(labmpc(i)(1:7).eq.'MEANROT') then
               if(nodempc(3,nodempc(3,index)).eq.0) cycle
            elseif(labmpc(i)(1:10).eq.'PRETENSION') then
               if(nodempc(3,index).eq.0) cycle
            elseif(labmpc(i)(1:5).eq.'RIGID') then
               if(nodempc(3,nodempc(3,nodempc(3,nodempc(3,nodempc(3,inde
     &x))))).eq.0) cycle
            else
               if(index.eq.0) cycle
            endif
            do
               node=nodempc(1,index)
               ndir=nodempc(2,index)
               fn(ndir,node)=fn(ndir,node)+coefmpc(index)*forcempc
               index=nodempc(3,index)
               if(labmpc(i)(1:7).eq.'MEANROT') then
                  if(nodempc(3,nodempc(3,index)).eq.0) exit
               elseif(labmpc(i)(1:10).eq.'PRETENSION') then
                  if(nodempc(3,index).eq.0) exit
               elseif(labmpc(i)(1:5).eq.'RIGID') then
                  if(nodempc(3,nodempc(3,nodempc(3,nodempc(3,nodempc(3,i
     &ndex))))).eq.0) exit
               else
                  if(index.eq.0) exit
               endif
            enddo
         enddo
      endif
!
      return