createinterfacempcs.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	createinterfacempcs (imastnode, xmastnor, nmastnode, ikmpc, ilmpc, nmpc, ipompc, nodempc, coefmpc, labmpc, mpcfree, ikboun, nboun)

Function/Subroutine Documentation

createinterfacempcs()

subroutine createinterfacempcs	(	integer, dimension(*)	imastnode,
		real*8, dimension(3,*)	xmastnor,
		integer	nmastnode,
		integer, dimension(*)	ikmpc,
		integer, dimension(*)	ilmpc,
		integer	nmpc,
		integer, dimension(*)	ipompc,
		integer, dimension(3,*)	nodempc,
		real*8, dimension(*)	coefmpc,
		character*20, dimension(*)	labmpc,
		integer	mpcfree,
		integer, dimension(*)	ikboun,
		integer	nboun
	)

!
      character*20 labmpc(*)
!
      integer imastnode(*),nmastnode,ikmpc(*),ilmpc(*),nmpc,
     &  nodempc(3,*),kflag,i,j,node,lnor(3),three,k,id,id1,
     &  ikboun(*),nboun,mpcfree,m,ipompc(*),mpcfreeold
!
      real*8 xmastnor(3,*),coefmpc(*),xnor(3)
!
      kflag=-2
      three=3
!
      loop: do i=1,nmastnode
         node=imastnode(i)
!
!        sorting the components of the normal in the node
!
         do j=1,3
            xnor(j)=xmastnor(j,i)
            lnor(j)=j
         enddo
         call dsort(xnor,lnor,three,kflag)
!
         do k=1,3
            j=lnor(k)
            idof=8*(node-1)+j
            call nident(ikmpc,idof,nmpc,id)
            if(id.gt.0) then
               if(ikmpc(id).eq.idof)cycle
            endif
            call nident(ikboun,idof,nboun,id1)
            if(id1.gt.0) then
               if(ikboun(id1).eq.idof)cycle
            endif
            if(dabs(xnor(k)).lt.1.d-20)cycle
!
!           create a MPC corresponding to A.n=0
!            
            nmpc=nmpc+1
            labmpc(nmpc)='                    '
            ipompc(nmpc)=mpcfree
!     
!     updating ikmpc and ilmpc
!     
            do m=nmpc,id+2,-1
               ikmpc(m)=ikmpc(m-1)
               ilmpc(m)=ilmpc(m-1)
            enddo
            ikmpc(id+1)=idof
            ilmpc(id+1)=nmpc
!     
            nodempc(1,mpcfree)=node
            nodempc(2,mpcfree)=j
            coefmpc(mpcfree)=xmastnor(j,i)
            mpcfree=nodempc(3,mpcfree)
            if(mpcfree.eq.0) then
               write(*,*)
     &            '*ERROR in createinterfacempcs: increase memmpc_'
               call exit(201)
            endif
!     
            j=j+1
            if(j.gt.3)j=1
            nodempc(1,mpcfree)=node
            nodempc(2,mpcfree)=j
            coefmpc(mpcfree)=xmastnor(j,i)
            mpcfree=nodempc(3,mpcfree)
            if(mpcfree.eq.0) then
               write(*,*)
     &            '*ERROR in createinterfacempcs: increase memmpc_'
               call exit(201)
            endif
!     
            j=j+1
            if(j.gt.3)j=1
            nodempc(1,mpcfree)=node
            nodempc(2,mpcfree)=j
            coefmpc(mpcfree)=xmastnor(j,i)
            mpcfreeold=mpcfree
            mpcfree=nodempc(3,mpcfree)
            if(mpcfree.eq.0) then
               write(*,*)
     &            '*ERROR in createinterfacempcs: increase memmpc_'
               call exit(201)
            endif
            nodempc(3,mpcfreeold)=0
!
            cycle loop
         enddo
!
         write(*,*) '*WARNING in createinterfacempcs: no A.n MPC'
         write(*,*) '         created for node ',node
!
      enddo loop
!     
      return