allocont.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	allocont (ncont, ntie, tieset, nset, set, istartset, iendset, ialset, lakon, ncone, tietol, ismallsliding, kind1, kind2, mortar, istep)

Function/Subroutine Documentation

allocont()

subroutine allocont	(	integer	ncont,
		integer	ntie,
		character*81, dimension(3,*)	tieset,
		integer	nset,
		character*81, dimension(*)	set,
		integer, dimension(*)	istartset,
		integer, dimension(*)	iendset,
		integer, dimension(*)	ialset,
		character*8, dimension(*)	lakon,
		integer	ncone,
		real*8, dimension(3,*)	tietol,
		integer	ismallsliding,
		character*1	kind1,
		character*1	kind2,
		integer	mortar,
		integer	istep
	)

!
!     counting the number of triangles needed for the 
!     triangulation of the contact master surfaces
!
!     ismallsliding = 0: large sliding
!                   = 1: small sliding
!
      implicit none
!
      logical nodeslavsurf
!
      character*1 kind1,kind2
      character*8 lakon(*)
      character*81 tieset(3,*),mastset,set(*),slavset
!
      integer ncont,ntie,i,j,k,nset,istartset(*),iendset(*),ialset(*),
     &  imast,nelem,jface,ncone,islav,ismallsliding,ipos,mortar,istep,
     &  kflag,idummy,jact
!
      real*8 tietol(3,*)
!
!     number of master triangles
!
      ncont=0
!
!     number of slave entities (nodes for nodal surfaces and
!     faces for facial surfaces)
!
      ncone=0
!
      do i=1,ntie
!
!        check for contact conditions
!
         if((tieset(1,i)(81:81).eq.kind1).or.
     &      (tieset(1,i)(81:81).eq.kind2)) then
            if(tietol(1,i).lt.0.d0) then
               ismallsliding=1
            else
               ismallsliding=0
            endif
            mastset=tieset(3,i)
!
!           determining the master surface
!
            do j=1,nset
               if(set(j).eq.mastset) exit
            enddo
            if(j.gt.nset) then
               ipos=index(mastset,' ')
               write(*,*) '*ERROR in allocont: master surface ',
     &               mastset(1:ipos-2)
               write(*,*) '       does not exist or does not contain'
               write(*,*) '       element faces'
               call exit(201)
            endif
            imast=j
!
!           deleting identical entries in the master facial surface
!           definition (leads otherwise to problems in the triangulation
!           and the creation of imastop)
!
            if(istep.eq.1) then
               kflag=1
               call isortii(ialset(istartset(imast)),idummy,
     &            iendset(imast)-istartset(imast)+1,kflag)
               jact=istartset(imast)
               do j=istartset(imast)+1,iendset(imast)
                  if(ialset(j).eq.ialset(j-1)) cycle
                  jact=jact+1
                  ialset(jact)=ialset(j)
               enddo
               iendset(imast)=jact
            endif
!
            do j=istartset(imast),iendset(imast)
!     
               nelem=int(ialset(j)/10.d0)
               jface=ialset(j)-10*nelem
!     
               if(lakon(nelem)(4:5).eq.'20') then
                  ncont=ncont+6
               elseif(lakon(nelem)(4:4).eq.'2') then
                  ncont=ncont+8
               elseif(lakon(nelem)(4:4).eq.'8') then
                  ncont=ncont+2
               elseif(lakon(nelem)(4:5).eq.'10') then
                  ncont=ncont+4
               elseif(lakon(nelem)(4:4).eq.'4') then
                  ncont=ncont+1
               elseif(lakon(nelem)(4:5).eq.'15') then
                  if(jface.le.2) then
                     ncont=ncont+4
                  else
                     ncont=ncont+6
                  endif
               elseif(lakon(nelem)(4:4).eq.'6') then
                  if(jface.le.2) then
                     ncont=ncont+1
                  else
                     ncont=ncont+2
                  endif
               endif
            enddo
!
!           counting the slave nodes
!
            slavset=tieset(2,i)
            ipos=index(slavset,' ')-1
            if(slavset(ipos:ipos).eq.'T') then
!
!              face-to-face penalty contact (facial slave surface)
!
               mortar=1
               nodeslavsurf=.false.
            elseif(slavset(ipos:ipos).eq.'M') then
!
!              quad-quad Mortar contact (facial slave surface)
!
               mortar=2
               nodeslavsurf=.false.
            elseif(slavset(ipos:ipos).eq.'P') then
!
!              quad-lin Petrov Galerkin Mortar contact (facial slave surface)
!
               mortar=4
               nodeslavsurf=.false.
            elseif(slavset(ipos:ipos).eq.'G') then
!
!              quad-quad Petrov Galerkin Mortar contact (facial slave surface)
!
               mortar=5
               nodeslavsurf=.false.
            elseif(slavset(ipos:ipos).eq.'O') then
!
!              quad-lin Mortar contact (facial slave surface)
!
               mortar=3
               nodeslavsurf=.false.
            else
!
!              node-to-face contact
!              default is a nodal slave surface
!
               nodeslavsurf=.true.
            endif
!
!           determining the slave surface
!
            do j=1,nset
               if(set(j).eq.slavset) exit
            enddo
            if(j.gt.nset) then
               if(mortar.eq.1) then
                  write(*,*) 
     &              '*ERROR in allocont: element slave surface ',
     &              slavset(1:ipos-1)
                  write(*,*) '       does not exist'
                  call exit(201)
               endif
               do j=1,nset
                  if((set(j)(1:ipos-1).eq.slavset(1:ipos-1)).and.
     &                 (set(j)(ipos:ipos).eq.'T')) then
                     nodeslavsurf=.false.
                     exit
                  endif
               enddo
               if(j.gt.nset) then
                  write(*,*) '*ERROR in allocont: slave surface ',
     &                 slavset(1:ipos-1)
                  write(*,*) '       does not exist'
                  call exit(201)
               endif
            endif
!
            islav=j
!
!           deleting identical entries in the slave facial surface
!           definition (leads otherwise to problems in the calculation
!           of the are corresponding to the slave nodes)
!
            if((istep.eq.1).and.((mortar.eq.1).or.(.not.nodeslavsurf)))
     &         then
               kflag=1
               call isortii(ialset(istartset(islav)),idummy,
     &            iendset(islav)-istartset(islav)+1,kflag)
               jact=istartset(islav)
               do j=istartset(islav)+1,iendset(islav)
                  if(ialset(j).eq.ialset(j-1)) cycle
                  jact=jact+1
                  ialset(jact)=ialset(j)
               enddo
               iendset(islav)=jact
            endif
!
!           counting the entities (nodes or faces) in the slave
!           surface
!
            do j=istartset(islav),iendset(islav)
               if(ialset(j).gt.0) then
                  ncone=ncone+1
               else
                  k=ialset(j-2)
                  do
                     k=k-ialset(j)
                     if(k.ge.ialset(j-1)) exit
                     ncone=ncone+1
                  enddo
               endif
            enddo
!
         endif
      enddo
!
      return