rigidmpc.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	rigidmpc (ipompc, nodempc, coefmpc, irefnode, irotnode, labmpc, nmpc, nmpc_, mpcfree, ikmpc, ilmpc, nk, nk_, nodeboun, ndirboun, ikboun, ilboun, nboun, nboun_, node, typeboun, co, jmin, jmax)

Function/Subroutine Documentation

rigidmpc()

subroutine rigidmpc	(	integer, dimension(*)	ipompc,
		integer, dimension(3,*)	nodempc,
		real*8, dimension(*)	coefmpc,
		integer	irefnode,
		integer	irotnode,
		character*20, dimension(*)	labmpc,
		integer	nmpc,
		integer	nmpc_,
		integer	mpcfree,
		integer, dimension(*)	ikmpc,
		integer, dimension(*)	ilmpc,
		integer	nk,
		integer	nk_,
		integer, dimension(*)	nodeboun,
		integer, dimension(*)	ndirboun,
		integer, dimension(*)	ikboun,
		integer, dimension(*)	ilboun,
		integer	nboun,
		integer	nboun_,
		integer	node,
		character*1, dimension(*)	typeboun,
		real*8, dimension(3,*)	co,
		integer	jmin,
		integer	jmax
	)

!
!     generates three rigid body MPC's for node "node" about reference
!     (translational) node irefnode and rotational node irotnode 
!
      implicit none
!
      character*1 typeboun(*)
      character*20 labmpc(*)
!
      integer ipompc(*),nodempc(3,*),nmpc,nmpc_,mpcfree,nk,nk_,
     &  ikmpc(*),jmin,jmax,
     &  ilmpc(*),node,id,mpcfreeold,j,idof,l,nodeboun(*),
     &  ndirboun(*),ikboun(*),ilboun(*),nboun,nboun_,irefnode,
     &  irotnode
!
      real*8 coefmpc(*),co(3,*),e(3,3,3)
!
      data e /0.,0.,0.,0.,0.,-1.,0.,1.,0.,
     &        0.,0.,1.,0.,0.,0.,-1.,0.,0.,
     &        0.,-1.,0.,1.,0.,0.,0.,0.,0./
!
      nk=nk+1
      if(nk.gt.nk_) then
         write(*,*) '*ERROR in rigidmpc: increase nk_'
         call exit(201)
      endif
c      do j=1,3
      do j=jmin,jmax
         idof=8*(node-1)+j
         call nident(ikmpc,idof,nmpc,id)
         if(id.gt.0) then
            if(ikmpc(id).eq.idof) then
               cycle
            endif
         endif
         nmpc=nmpc+1
         if(nmpc.gt.nmpc_) then
            write(*,*) '*ERROR in rigidmpc: increase nmpc_'
            call exit(201)
         endif
!
         ipompc(nmpc)=mpcfree
         labmpc(nmpc)='RIGID               '
!
         do l=nmpc,id+2,-1
            ikmpc(l)=ikmpc(l-1)
            ilmpc(l)=ilmpc(l-1)
         enddo
         ikmpc(id+1)=idof
         ilmpc(id+1)=nmpc
!
         nodempc(1,mpcfree)=node
         nodempc(2,mpcfree)=j
         coefmpc(mpcfree)=1.d0
         mpcfree=nodempc(3,mpcfree)
!
!        translation term
!
         nodempc(1,mpcfree)=irefnode
         nodempc(2,mpcfree)=j
         coefmpc(mpcfree)=-1.d0
         mpcfree=nodempc(3,mpcfree)
!
!        rotation terms
!
         nodempc(1,mpcfree)=irotnode
         nodempc(2,mpcfree)=1
         coefmpc(mpcfree)=e(j,1,1)*(co(1,irefnode)-co(1,node))+
     &        e(j,1,2)*(co(2,irefnode)-co(2,node))+
     &        e(j,1,3)*(co(3,irefnode)-co(3,node))
         mpcfree=nodempc(3,mpcfree)
         nodempc(1,mpcfree)=irotnode
         nodempc(2,mpcfree)=2
         coefmpc(mpcfree)=e(j,2,1)*(co(1,irefnode)-co(1,node))+
     &        e(j,2,2)*(co(2,irefnode)-co(2,node))+
     &        e(j,2,3)*(co(3,irefnode)-co(3,node))
         mpcfree=nodempc(3,mpcfree)
         nodempc(1,mpcfree)=irotnode
         nodempc(2,mpcfree)=3
         coefmpc(mpcfree)=e(j,3,1)*(co(1,irefnode)-co(1,node))+
     &        e(j,3,2)*(co(2,irefnode)-co(2,node))+
     &        e(j,3,3)*(co(3,irefnode)-co(3,node))
         mpcfree=nodempc(3,mpcfree)
         nodempc(1,mpcfree)=nk
         nodempc(2,mpcfree)=j
         coefmpc(mpcfree)=1.d0
         mpcfreeold=mpcfree
         mpcfree=nodempc(3,mpcfree)
         nodempc(3,mpcfreeold)=0
         idof=8*(nk-1)+j
         call nident(ikboun,idof,nboun,id)
         nboun=nboun+1
         if(nboun.gt.nboun_) then
            write(*,*) '*ERROR in rigidmpc: increase nboun_'
            call exit(201)
         endif
         nodeboun(nboun)=nk
         ndirboun(nboun)=j
         typeboun(nboun)='R'
         do l=nboun,id+2,-1
            ikboun(l)=ikboun(l-1)
            ilboun(l)=ilboun(l-1)
         enddo
         ikboun(id+1)=idof
         ilboun(id+1)=nboun
       enddo
!
       return