createinum.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	createinum (ipkon, inum, kon, lakon, nk, ne, cflag, nelemload, nload, nodeboun, nboun, ndirboun, ithermal, co, vold, mi, ielmat)

Function/Subroutine Documentation

createinum()

subroutine createinum	(	integer, dimension(*)	ipkon,
		integer, dimension(*)	inum,
		integer, dimension(*)	kon,
		character*8, dimension(*)	lakon,
		integer	nk,
		integer	ne,
		character*1	cflag,
		integer, dimension(2,*)	nelemload,
		integer	nload,
		integer, dimension(*)	nodeboun,
		integer	nboun,
		integer, dimension(*)	ndirboun,
		integer, dimension(2)	ithermal,
		real*8, dimension(3,*)	co,
		real*8, dimension(0:mi(2),*)	vold,
		integer, dimension(*)	mi,
		integer, dimension(mi(3),*)	ielmat
	)

!
!     determines inum in case no extrapolation is requested in the
!     input deck (e.g. only nodal variables are requested)
!
      implicit none
!
      logical force
!
      character*1 cflag
      character*8 lakon(*),lakonl
!
      integer ipkon(*),inum(*),kon(*),ne,indexe,nope,nfield,mi(*),
     &  nk,i,j,nelemload(2,*),nload,node,nboun,nlayer,nopeexp,
     &  nodeboun(*),ndirboun(*),ithermal(2),ielmat(mi(3),*)
!
      real*8 yn,co(3,*),vold(0:mi(2),*)
!
      force=.false.
!
      do i=1,nk
         inum(i)=0
      enddo
!
      do i=1,ne
!
         if(ipkon(i).lt.0) cycle
         indexe=ipkon(i)
         lakonl=lakon(i)
!
         if(lakonl(7:8).eq.'LC') then
            nlayer=0
            do j=1,mi(3)
               if(ielmat(j,i).gt.0) then
                  nlayer=nlayer+1
               else
                  exit
               endif
            enddo
!
            if(lakonl(4:4).eq.'2') then
               nopeexp=28
            elseif(lakonl(4:5).eq.'15') then
               nopeexp=21
            endif
         endif
!
         if(lakonl(1:1).eq.'F') then
            cycle
         elseif(lakonl(4:4).eq.'2') then
            nope=20
         elseif(lakonl(4:4).eq.'8') then
            nope=8
         elseif(lakonl(4:5).eq.'10') then
            nope=10
         elseif(lakonl(4:4).eq.'4') then
            nope=4
         elseif(lakonl(4:5).eq.'15') then
            nope=15
         elseif(lakonl(4:4).eq.'6') then
            nope=6
         elseif((lakon(i)(1:1).eq.'E').and.(lakon(i)(7:7).eq.'A'))then
            inum(kon(indexe+1))=inum(kon(indexe+1))+1
            inum(kon(indexe+2))=inum(kon(indexe+2))+1
            cycle
         elseif(lakonl(1:7).eq.'ESPRNGF') then
            read(lakonl(8:8),'(i1)') nope
            nope=nope+1
            inum(kon(indexe+nope))=-1
            cycle
         else
            cycle
         endif
!
!        counting the number of elements a node belongs to
!
         if(lakonl(7:8).ne.'LC') then
            do j=1,nope
               inum(kon(indexe+j))=inum(kon(indexe+j))+1
            enddo
         else
            do j=1,nope*nlayer
               inum(kon(indexe+nopeexp+j))=inum(kon(indexe+nopeexp+j))+1
            enddo
         endif
c     Bernhardi start
c        incompatible modes elements
c         if(lakonl(1:5).eq.'C3D8I') then
c            do j=1,3
c               inum(kon(indexe+nope+j))=inum(kon(indexe+nope+j))+1
c            enddo
c         endif
c     Bernhardi end
!
      enddo
!
!     for 1d and 2d elements only:
!     finding the solution in the original nodes
!
      if((cflag.ne.' ').and.(cflag.ne.'E')) then
         nfield=0
         call map3dto1d2d(yn,ipkon,inum,kon,lakon,nfield,nk,ne,cflag,co,
     &         vold,force,mi)
      endif
!
      return