!
!     CalculiX - A 3-dimensional finite element program
!              Copyright (C) 1998-2011 Guido Dhondt
!
!     This program is free software; you can redistribute it and/or
!     modify it under the terms of the GNU General Public License as
!     published by the Free Software Foundation(version 2);
!     
!
!     This program is distributed in the hope that it will be useful,
!     but WITHOUT ANY WARRANTY; without even the implied warranty of 
!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
!     GNU General Public License for more details.
!
!     You should have received a copy of the GNU General Public License
!     along with this program; if not, write to the Free Software
!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
      subroutine surfaces(inpc,textpart,set,istartset,iendset,ialset,
     &  nset,nset_,nalset,nalset_,nk,ne,istep,istat,n,iline,ipol,
     &  inl,ipoinp,inp,lakon,ipoinpc)
!
!     reading the input deck: *SURFACE
!
      implicit none
!
      character*1 type,inpc(*)
      character*8 lakon(*)
      character*20 label,newlabel
      character*81 set(*),noset,elset,noelset
      character*132 textpart(16)
!
      integer nset,nset_,nalset,nalset_,istep,istat,n,key,i,nk,ne,
     &  j,istartset(*),iendset(*),ialset(*),ipos,iline,ipol,inl,
     &  ipoinp(2,*),inp(3,*),iside,l,k,kstart,kend,ipoinpc(0:*),
     &  iset,nn,kincrement
!
      if(istep.gt.0) then
         write(*,*) '*ERROR in surfaces: *SURFACE should be placed'
         write(*,*) '  before all step definitions'
         stop
      endif
!
      kstart=0
      kend=0
!
      type='T'
!
      do i=2,n
         if(textpart(i)(1:5).eq.'NAME=')
     &        then
            noelset(1:80)=textpart(i)(6:85)
            noelset(81:81)=' '
            if(textpart(i)(86:86).ne.' ') then
               write(*,*) '*ERROR in surfaces: surface name too long'
               write(*,*) '       (more than 80 characters)'
               write(*,*) '       surface name:',textpart(i)(1:132)
               stop
            endif
         elseif(textpart(i)(1:5).eq.'TYPE=') then
            if(textpart(i)(6:12).eq.'ELEMENT') then
               type='T'
            elseif(textpart(i)(6:9).eq.'NODE') then
               type='S'
            else
               write(*,*) '*ERROR in surfaces: unknown surface type'
               stop
            endif
         else
            write(*,*) 
     &        '*WARNING in surfaces: parameter not recognized:'
            write(*,*) '         ',
     &                 textpart(i)(1:index(textpart(i),' ')-1)
            call inputwarning(inpc,ipoinpc,iline)
         endif
      enddo
!
      ipos=index(noelset,' ')
      if(ipos.eq.1) then
         write(*,*) '*ERROR in surfaces: no name specified'
         stop
      endif
      noelset(ipos:ipos)=type
!
!     check whether new set or old set (a *SURFACE can be used to
!     extend an already existing surface)
!
      do iset=1,nset
         if(set(iset).eq.noelset) then
!
!           existent set
!
            if(iendset(iset).eq.nalset) then
               exit
            else
!
!              rearranging set information towards the end
!
               nn=iendset(iset)-istartset(iset)+1
               if(nalset+nn.gt.nalset_) then
                  write(*,*)'*ERROR in noelsets: increase nalset_'
                  stop
               endif
               do k=1,nn
                  ialset(nalset+k)=ialset(istartset(iset)+k-1)
               enddo
               do k=istartset(iset),nalset
                  ialset(k)=ialset(k+nn)
               enddo
               do k=1,nset
                  if(istartset(k).gt.iendset(iset)) then
                     istartset(k)=istartset(k)-nn
                     iendset(k)=iendset(k)-nn
                  endif
               enddo
               istartset(iset)=nalset-nn+1
               iendset(iset)=nalset
               exit
            endif
         endif
      enddo
      if(iset.gt.nset) then
         nset=nset+1
         if(nset.gt.nset_) then
            write(*,*) '*ERROR in noelsets: increase nset_'
            stop
         endif
         set(nset)=noelset
         istartset(nset)=nalset+1
         iendset(nset)=0
         iset=nset
      endif
!
      if(type.eq.'S') then
!
!        node surface
!
         do
            call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
     &           ipoinp,inp,ipoinpc)
            if((istat.lt.0).or.(key.eq.1)) then
               if(iendset(nset).eq.0) then
                  nset=nset-1
               endif
               return
            endif
            if(n.gt.1) then
               write(*,*) '*ERROR in surfaces: only one entry per'
               write(*,*) '       line allowed'
               call inputerror(inpc,ipoinpc,iline)
            endif
!
            if(nalset+1.gt.nalset_) then
               write(*,*) '*ERROR in surfaces: increase nalset_'
               stop
            endif
!     
            read(textpart(1)(1:10),'(i10)',iostat=istat)ialset(nalset+1)
            if(istat.gt.0) then
               noset=textpart(1)(1:80)
               noset(81:81)=' '
               ipos=index(noset,' ')
               noset(ipos:ipos)='N'
               do i=1,nset
                  if(set(i).eq.noset) then
                     do j=istartset(i),iendset(i)
                        if(ialset(j).gt.0) then
                           nalset=nalset+1
                           if(nalset.gt.nalset_) then
                              write(*,*) 
     &                           '*ERROR in surfaces: increase nalset_'
                              stop
                           endif
                           ialset(nalset)=ialset(j)
                        else
                           kstart=ialset(nalset-1)
                           kend=ialset(nalset)
                           nalset=nalset-1
                           kincrement=-ialset(j)
                           do k=kstart+kincrement,kend,kincrement
                              nalset=nalset+1
                              if(nalset.gt.nalset_) then
                                 write(*,*) 
     &                            '*ERROR in surfaces: increase nalset_'
                                 stop
                              endif
                              ialset(nalset)=k
                           enddo
                        endif
                     enddo
                     iendset(iset)=nalset
                     exit
                  endif
               enddo
               if(i.gt.nset) then
                  noset(ipos:ipos)=' '
                  write(*,*) '*ERROR in surfaces: node set ',noset
                  write(*,*) '       does not exist'
                  stop
               endif
            else
               if(ialset(nalset+1).gt.nk) then
                  write(*,*) '*WARNING in surfaces: value ',
     &                 ialset(nalset+1)
                  write(*,*) '         in set ',set(iset),' > nk'
               else
                  nalset=nalset+1
                  iendset(iset)=nalset
               endif
            endif
         enddo
!
      else
!
!        element surface
!
         do
            call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
     &           ipoinp,inp,ipoinpc)
            if((istat.lt.0).or.(key.eq.1)) then
               if(iendset(nset).eq.0) then
                  nset=nset-1
               endif
               return
            endif
            if(nalset+1.gt.nalset_) then
               write(*,*) '*ERROR in surfaces: increase nalset_'
               stop
            endif
!
            read(textpart(2)(1:20),'(a20)',iostat=istat) label
!     
            if(label(2:4).eq.'NEG') then
               label(2:4)='1  '
            elseif(label(2:4).eq.'POS') then
               label(2:4)='2  '
            endif
            if(label(2:2).eq.'N') then
               label(2:2)='5'
            elseif(label(2:2).eq.'P') then
               label(2:2)='6'
            endif
!
            if((label(1:2).ne.'S1').and.(label(1:2).ne.'S2').and.
     &         (label(1:2).ne.'S3').and.(label(1:2).ne.'S4').and.
     &         (label(1:2).ne.'S5').and.(label(1:2).ne.'S6')) then
               call inputerror(inpc,ipoinpc,iline)
            endif
!            
            read(textpart(1)(1:10),'(i10)',iostat=istat)l
            if(istat.gt.0) then
               elset=textpart(1)(1:80)
               elset(81:81)=' '
               ipos=index(elset,' ')
               elset(ipos:ipos)='E'
               do i=1,nset
                  if(set(i).eq.elset) then
                     do j=istartset(i),iendset(i)
                        l=ialset(j)
                        if(l.gt.0) then
                           kstart=kend
                           kend=l
                           nalset=nalset+1
                           if(nalset.gt.nalset_) then
                              write(*,*) 
     &                           '*ERROR in surfaces: increase nalset_'
                              stop
                           endif
                           newlabel=label
                           if((lakon(l)(1:2).eq.'CP').or.
     &                          (lakon(l)(2:2).eq.'A')) then
                              if(label(1:2).eq.'S1') then
                                 newlabel(1:2)='S3'
                              elseif(label(1:2).eq.'S2') then
                                 newlabel(1:2)='S4'
                              elseif(label(1:2).eq.'S3') then
                                 newlabel(1:2)='S5'
                              elseif(label(1:2).eq.'S4') then
                                 newlabel(1:2)='S6'
                              elseif(label(1:2).eq.'S5') then
                                 newlabel(1:2)='S1'
                              elseif(label(1:2).eq.'S6') then
                                 newlabel(1:2)='S2'
                              endif
                           endif
                           read(newlabel(2:2),'(i1)',iostat=istat) iside
                           ialset(nalset)=iside+10*l
                        else
                           kstart=kstart
                           nalset=nalset-1
                           kincrement=-ialset(j)
                           do l=kstart+kincrement,kend,kincrement
                              nalset=nalset+1
                              if(nalset.gt.nalset_) then
                                 write(*,*) 
     &                            '*ERROR in surfaces: increase nalset_'
                                 stop
                              endif
                              newlabel=label
                              if((lakon(l)(1:2).eq.'CP').or.
     &                             (lakon(l)(2:2).eq.'A')) then
                                 if(label(1:2).eq.'S1') then
                                    newlabel(1:2)='S3'
                                 elseif(label(1:2).eq.'S2') then
                                    newlabel(1:2)='S4'
                                 elseif(label(1:2).eq.'S3') then
                                    newlabel(1:2)='S5'
                                 elseif(label(1:2).eq.'S4') then
                                    newlabel(1:2)='S6'
                                 elseif(label(1:2).eq.'S5') then
                                    newlabel(1:2)='S1'
                                 elseif(label(1:2).eq.'S6') then
                                    newlabel(1:2)='S2'
                                 endif
                              endif
                              read(newlabel(2:2),'(i1)',iostat=istat) 
     &                              iside
                              ialset(nalset)=iside+10*l
                           enddo
                        endif
                     enddo
                     iendset(iset)=nalset
                     exit
                  endif
               enddo
               if(i.gt.nset) then
                  elset(ipos:ipos)=' '
                  write(*,*) '*ERROR in surfaces: element set ',elset
                  write(*,*) '       does not exist'
                  stop
               endif
            else
               if(l.gt.ne) then
                  write(*,*) '*WARNING in surfaces: value ',
     &                 ialset(nalset+1)
                  write(*,*) '         in set ',set(iset),' > ne'
               else
                  newlabel=label
                  if((lakon(l)(1:2).eq.'CP').or.
     &                 (lakon(l)(2:2).eq.'A')) then
                     if(label(1:2).eq.'S1') then
                        newlabel(1:2)='S3'
                     elseif(label(1:2).eq.'S2') then
                        newlabel(1:2)='S4'
                     elseif(label(1:2).eq.'S3') then
                        newlabel(1:2)='S5'
                     elseif(label(1:2).eq.'S4') then
                        newlabel(1:2)='S6'
                     elseif(label(1:2).eq.'S5') then
                        newlabel(1:2)='S1'
                     elseif(label(1:2).eq.'S6') then
                        newlabel(1:2)='S2'
                     endif
                  endif
                  read(newlabel(2:2),'(i1)',iostat=istat) iside
                  nalset=nalset+1
                  ialset(nalset)=iside+10*l
                  iendset(iset)=nalset
               endif
            endif
         enddo
      endif
!     
      return
      end

