C RFCO      SOURCE    CHAT      12/01/17    21:15:56     7248           
      subroutine rfco
      implicit real*8(a-h,o-z)
      implicit integer (i-n)
*
*  calcul des raideurs et des jeux dans le cas de modeles de contact 
*  avec ou sans frottements
* le chpoint existe en cas de contacts ( pas pour les frocable)
*  en sortie : une raideur et un chpoint et une deuxieme raideur. 
*  La premiere raideur est celle des contacts, n'existe pas pour frocable
*  la deuxieme raisdeur existe si lconv est vrai et si contact frottant(
*  frocable ou coulomb)
*
-INC CCOPTIO
-INC SMMODEL
      pointeur mmode3.mmodel,imode3.imodel
-INC SMRIGID
-INC SMCHPOI
      logical lconv
      call lirobj ('MMODEL',mmodel,1,iretou)
      if(ierr.ne.0) return
      call lirlog(lconv,1,iretou)
*      call lirobj('CHPOINT', mchip1,0,irchp1)
      if(ierr.ne.0) return
      mrigid=0
      mforc=0
      irigi2=0
      irrr=0
      ifff=0
      irff=0      
      segact mmodel
      nsous= kmodel(/1)      
      do isous=1,nsous
        imodel=kmodel(isous)
        segact imodel
*       write(6,*) ' boucfle sur modele isous ', isous,imamod
* pour l'instant 
* imate=1 unilateral; imate=2 maintenu; inatu=0 pas de frottement
* inatu=1 coulomb; inatu=2 frocable ( voir nomate)
        if( imatee.eq.0) then
* cas de maintenu avec ou sans coulomb  pas encore traité     
        elseif(imatee.eq.1) then        
* cas de contact unilateral 
          if(inatuu.eq.2) then
            if( lconv) then     
*cas de frocable                                 
* pour les cables la notion maintenu n'existe pas               ifff=0
              irff=1
*     Petit modele unitaire local (a detruire en fin de traitement)
              n1=1
              segini,mmode2
*     Option accro 'GLISS'
              igliss=1              
              segact imodel
              if(ivamod(/1).ne.2) call erreur(5)              
              ri2 = 0         
              meleme=ivamod(2)
              ipt1= ivamod(1)   
*              call ecmail( meleme,1)
*              call ecmail ( ipt1,1)      
              nfor=0          
              nobmod=1
              mn3=0
              nmat=0
              segini mmode3           
              segini imode2 
              imode2.imamod=imamod            
              imode2.ivamod(1)=mmode3
              imode2.tymode(1)='MMODEL'
              segdes imode2
              mmode2.kmodel(1)=imode2
              segini imode3
              imode3.imamod=ipt1 
              mmode3.kmodel(1)=imode3
              segdes mmode3
               segdes imodel
              call ecrree(1.e-3)
              call ecrobj('MAILLAGE',meleme)
              call ecrobj('MMODEL  ',mmode2)
              call accro(igliss)
              if (ierr.ne.0) goto 9000
              call lirobj('RIGIDITE',ri2,1,iretou)
              if (ierr.ne.0) goto 9000
              segsup mmode2  
              if( irigi2.eq.0) then
                irigi2=ri2
              else 
                call fusrig(irigi2,ri2,Inoup)
                irigi2= inoup
              endif  
* dessous fin du cas frocable
            endif
          else
* cas du frottement de coulomb ou de pas de frottement
*           on commence par le contact unilateral
            call ecrobj('MAILLAGE',imamod)
            if(idim.eq.3) call impo32 
            if(idim.eq.2) then
              if (ifomod .ne. -1 .and. ifomod .ne. 0) then
                 call erreur(710)
                 return
              endif
              call impos2
            endif
            call lirobj('RIGIDITE',ri2,1,iretou)
            call lirobj('CHPOINT',mchpo2,1,iretou)
            irrr=1
            ifff=1
            if( mrigid.eq.0) then
               mrigid=ri2
            else
               call fusrig ( ri2 , mrigid, inoup)
               mrigid=inoup
            endif
            if( mforc.eq.0) then
               mforc=mchpo2
            else
               call adchpo(mchpo2,mforc,iret,1.d0,1.D0)
               mforc=iret
            endif           
            if( lconv) then     
*    on fait aussi le frottement si on avait convergé.        
              if( inatuu.eq.1 ) then   
                 meleme=ivamod(1)                    
                 if(mchpo2.eq.0) then
                   call erreur (19)
                   return
                 endif
                 ri1=0
                 if (idim .eq. 3) then
                   call frig3C(meleme,ri2,mchpo2, ri1)
                 else
                   call frig2C(meleme,ri2,mchpo2, ri1)
*                   write(6,*) ' sortie de frig2c ri2 '
*                   call prrigi ( ri2,1)
*                   write(6,*) ' sortie de frig2c ri1'
*                   call prrigi( ri1,1)
*                   write(6,*) ' fin ecrituere apres frig2c'
                 endif
                 if (ierr.ne.0 .or. ri2.eq.0) goto 9000
                 if(irigi2.eq.0) then
                    irigi2=ri1
                 else 
                   call fusrig(irigi2,ri1,inoup)
                   irigi2=inoup
                 endif
              endif
            endif
          endif
        endif
        segdes imodel
      enddo
      segdes mmodel
*
*  on reordonne mrigid pour mettre en premier toutes 
*  les relations unilatérales ( frocables peut en sortir des pas unil)
* 
*  la premiere raideur ne contient que des relations unilaterales pour 
* l'instant
* la deuxieme continet aussi les relations normales d'encasdtrement des 
* cables glissants
      iraid1=mrigid
      mrigid=irigi2
      if( mrigid.ne.0) then
        segini,ri1=mrigid
        ide=0
        segact mrigid
        ifi=irigel(/2)+1
        do i=1,irigel(/2)
          if( irigel(6,i). eq .0) then
            ifi=ifi-1
            ipla=ifi
          else
           ide=ide+1
            ipla=ide
          endif
          do ib=1,irigel(/1)
            ri1.irigel(ib,ipla)=irigel(ib,i)
          enddo 
          ri1.coerig(ipla)= coerig(i)
        enddo
        segdes ri1
        segsup mrigid 
        mrigid=ri1 
      endif
      if(mrigid.eq.0)   then
        call ecrent ( mrigid)
      else
        call  ecrobj('RIGIDITE',mrigid)
      endif 
      if(iraid1.eq.0) then
         call ecrent ( iraid1)
      else         
        call  ecrobj('RIGIDITE',iraid1)
      endif  
      if( mforc.eq.0) then
         call ecrent (mforc)
      else
         call ecrobj('CHPOINT', mforc)
      endif
      return
 9000 continue
      call erreur (19)
      return
      end