C CHATAB    SOURCE    FANDEUR   11/04/12    21:15:12     6938           
      subroutine chatab
      implicit real*8(a-h,o-z)
      implicit integer (i-n)
*
*  ce sous programme permet de changer fabriquer un chargement  
*  defini par deux tables pour le type demandé. ou pour tous les types.
*  il ne travaille que sur les chpoints.
*
-INC CCOPTIO
-INC SMCHARG
-INC SMCOORD
-INC SMCHPOI
-INC TMTRAV
-INC SMELEME
-INC SMLREEL
-INC SMTABLE
       segment nominc
         character*4 noinc(ml)
         integer noh(ml)
       endsegment
       segment mtempo
          real*8 tempo(ml)
       endsegment
       segment iliste
          integer listem (ibon)
       endsegment
       segment mbbb
         real*8 bbb(ntem,nnin,nnnoe)
       endsegment
       pointeur mlree4.mlreel
       segment ipass(nnin)
*
      segment icpr(xcoor(/1)/( idim+1))
      character*4 moty
      call lirobj ('CHARGEME',mcharg,1,iretou)
      if(ierr.ne.0) return
      moty='    '
      call lircha(moty,0,ilong)
      segact mcharg
      ik= kcharg(/1)
*
*     on verifie que le type de chargement demandé existe 
*         
      ibon=0
      do ikk=1,ik
        if(chanom(ikk).eq.moty) ibon=ibon+1
      enddo
      if(ibon.eq.0) then
        call erreur(19)
        return
      endif
*
*     on verifie que les chargelments concernés ont des objets chpoint 
* 
      ibon=0  
      iprem=0   
      do ikk=1,ik
        if(chanom(ikk).eq.moty)then
          icharg=kcharg(ikk)
          segact icharg
          if(chatyp.eq.'CHPOINT ') then
              ibon=ibon+1
              if(iprem.eq.0) iprem=ikk
          endif
         endif
      enddo
      if(ibon.eq.0) then
        call erreur(19)
        return
      endif
*
*     on duplique le'objet en sautant ceux qui vont etre transformés
*  
      N= ik - ibon + 1
      segini mchar1
      ipl=1              
      do ikk=1,N
        if(chanom(ikk).eq.moty)then
          icharg=kcharg(ikk)
          if(chatyp.ne.'CHPOINT ') then
             mchar1.kcharg(ipl)=kcharg(ikk)
             mchar1.CHANAT(ipl)=CHANAT(ikk)
             mchar1.CHANOM(ipl)=CHANOM(ikk)
             mchar1.CHAMOB(ipl)=CHAMOB(ikk)
             mchar1.CHALIE(ipl)=CHALIE(ikk)
             ipl=ipl+1
          endif
        endif
      enddo
*
*   debut du travail
*     
* on fabrique la liste des inconnues
*
      ml=100
      segini nominc
      nnin=0
      do ikk=1,ik 
        if(chanom(ikk).eq.moty)then
          icharg=kcharg(ikk) 
          if(chatyp.eq.'CHPOINT ') then
            mchpoi=ichpo1
            segact mchpoi
            do ipc=1,ipchp(/1)
              msoupo=ipchp(ipc)
              segact msoupo
              do nc=1,nocomp(/2)
                do nomb=1,nnin
                  if( nocomp(nc).eq.noinc(nomb)) go to 1
                enddo
                nnin=nnin+1
                if( nnin.gt.ml) then
                  ml= ml+100 
                  segadj nominc
                endif
                noinc(nnin)=nocomp(nc)
                noh(nnin)=noharm(nc)
    1           continue            
              enddo
            enddo
          endif
        endif
      enddo 
*
*  on fabrique la liste des temps
*
      ml = 500
      segini mtempo      
      segini iliste
      mlree3=0  
      do ikk=1,ik  
        if(chanom(ikk).eq.moty)then
          icharg=kcharg(ikk) 
          if(chatyp.eq.'CHPOINT ') then       
            mlree1=ichpo2
            do ikkm1= 1,ikk-1
              if( listem(ikkm1) . eq . mlree1) go to 2
            enddo
            listem(ikk)=mlree1
            if(mlree3.eq.0) then 
              segini,mlree3=mlree1
            else
              segact mlree1
              jg1=mlree1.prog(/1)
              jg3=mlree3.prog(/1)
              jg= mlree1.prog(/1)+mlree3.prog(/1)
              segini mlree2
              i3=1
              i1=1
              i2=1
    3         continue
              if( mlree1.prog(I1).le.mlree3.prog(i3))then
                mlree2.prog(i2)=mlree1.prog(I1)
                i2=i2+1
                if( mlree3.prog(i3).eq.mlree1.prog(I1)) i3 = i3 +1
                i1=i1+1
              else
                mlree2.prog(i2)=mlree3.prog(I3)
                i2=i2+1
                i3=i3+1
              endif  
              if(i1+i3.le.jg1+jg3)then
                if( i1.gt. jg1) then
                  i2=i2-1
                  i3=i3-1
                  do ifi=1,jg3-i3
                    mlree2.prog(i2+ifi)=mlree3.prog(i3+ifi)
                  enddo
                  i2=I2+jg3-i3
                elseif (i3.gt.jg3) then
                  i2=i2-1
                  i1=i1-1
                  do ifi=1,jg1-i1
                    mlree2.prog(i2+ifi)=mlree1.prog(i1+ifi)
                  enddo
                  i2=I2+jg1-i1
                else
                  go to 3
                endif
              endif
              jg=i2-1
              segsup mlree3
              segadj mlree2
              mlree3=mlree2
              segdes mlree1 
            endif
          endif
        endif
    2   continue
      enddo 
      
      ntem=mlree3.prog(/1)  
      xmax= mlree3.prog(ntem)
      xprec= xmax /ntem * 1.d-4 
*
* on fabrique la liste des points concernés
*
      segini icpr
      nnnoe=0
      do ikk=1,ik 
        if(chanom(ikk).eq.moty)then
          icharg=kcharg(ikk) 
          if(chatyp.eq.'CHPOINT ') then
            mchpoi=ichpo1        
            do ipc=1,ipchp(/1)
              msoupo=ipchp(ipc)
              meleme=igeoc
              segact meleme
              do iel=1,num(/2)
                ip=num(1,iel)
                if(icpr(ip).eq.0) then
                  nnnoe=nnnoe+1
                  icpr(ip)=nnnoe
                endif
              enddo
            enddo
          endif
        endif
      enddo
      nbnn=1
      nbelem=nnnoe
      nbsous=0
      nbref=0
      segini ipt4
      ipt4.itypel=1
      do ip=1,icpr(/1)
        if(icpr(ip).ne.0) then
          ipt4.num(1,icpr(ip))=ip
        endif
      enddo
      segdes ipt4
*
*  on cree le segment mtrav et on cree le segment contenant tous les 
* ntem chpoints
*     
*      write(6,*)'ntem nnin nnnoe  tot ',ntem,nnin,nnnoe,ntem*nnin*nnnoe 
      segini mtrav
      segini mbbb
*
*     on remplit les tableaux bbb en prenant chargement par chargement 
* 
      segini ipass 
      jg3=mlree3.prog(/1)         
      do ikk=1,ik 
        if(chanom(ikk).eq.moty)then
          icharg=kcharg(ikk) 
          if(chatyp.eq.'CHPOINT ') then
*          write(6,*) ' traitement du chargement numero ',ikk 
            mchpoi=ichpo1    
            mlree1=ichpo2
            mlree4=ichpo3
            segact mlree4
            segact mlree1
            jg1=mlree1.prog(/1)
            do ipc=1,ipchp(/1)
              msoupo=ipchp(ipc)
              meleme=igeoc
              mpoval=ipoval
              segact mpoval
* on cherche la correspondance nocomp -> noinc
              do ipu=1,nocomp(/2)
                do jpu=1,nnin
                  if( nocomp(ipu).eq.noinc(jpu)) then
                    ipass (ipu)=jpu
                    go to 5
                  endif
                enddo
    5           continue
              enddo 
*  on boucle sur les temps
              I1=1
              i3=1
    6         continue
              if( mlree3.prog(i3).lt.mlree1.prog(i1)) then
                if( i1.eq.1) then
                  coe = mlree4.prog(1)
                else
                  coe = mlree4.prog(i1-1) + 
     $            (mlree3.prog(i3) -mlree1.prog(i1-1))/
     $            (mlree1.prog(i1) -mlree1.prog(i1-1))* 
     $            (mlree4.prog(i1)-mlree4.prog(i1-1))
                endif
              elseif (mlree3.prog(i3).eq.mlree1.prog(i1)) then
                  coe =  mlree4.prog(i1)
                  i1=I1+1
              else
                if(i1.eq.jg1) then
                  coe = mlree4.prog(i1)
                else
                  i1=i1+1
                  go to 6
                endif
              endif
              do ipp=1,vpocha(/1)
                ie=icpr(num(1,ipp))
                do inn=1,vpocha(/2)
                  icomp=ipass(inn)
                  bbb(i3,icomp,ie)=bbb(i3,icomp,ie)+vpocha(ipp,inn)*coe
                enddo
              enddo
              i3=i3+1
              if(i3.le.jg3) go to 6
              segdes mpoval,meleme
            enddo
            segdes mlree1,mlree4,icharg
          endif
        endif
        
      enddo
*
* il faut creer le chargement de type table
*    
      nc=nnin
      n=nnnoe
      m=ntem
      segini mtab1,mtab2  
      mtab1.mlotab=ntem   
      mtab2.mlotab=ntem
      do i=1,ntem
        mtab1.mtabti(i)='ENTIER'
        mtab1.mtabii(i)=i-1
        mtab1.mtabtv(i)='CHPOINT '      
        mtab2.mtabti(i)='ENTIER'
        mtab2.mtabii(i)=i-1
        mtab2.mtabtv(i)='FLOTTANT'
        mtab2.rmtabv(i)=mlree3.prog(i)
        nsoupo=1
        nat=1
        segini mchpoi
        mtab1.mtabiv(i)=mchpoi
        mtypoi='FORCES'
        jattri(1)=2
        segini msoupo
        ipchp(1)=msoupo
        igeoc=ipt4
        segini mpoval
        ipoval=mpoval
        do io=1,nnin
          nocomp(io)=noinc(io)
          noharm(io)=noh(io)
        enddo
        do ip=1,nc
          do io=1,n
            vpocha(io,ip) = bbb(i,ip,io)
          enddo
        enddo
        segdes mpoval
        segdes msoupo
        segdes mchpoi
      enddo
      segdes mtab1,mtab2
      segdes mlree3
      segini icharg
      mchar1.kcharg(ipl)=icharg
      mchar1.chanat(ipl)='FORCE'
      mchar1.CHANOM(ipl)=CHANOM(iprem)
      mchar1.CHAMOB(ipl)=CHAMOB(iprem)
      mchar1.CHALIE(ipl)=CHALIE(iprem)
      CHATYP='TABLE   '
      ichpo1=mtab2
      ichpo2=mtab1
      segdes icharg
      segdes mchar1,mcharg
      call ecrobj('CHARGEME',mchar1)

      return
      end