C TRANSR    SOURCE    CHAT      09/10/09    21:25:37     6519           
*  transfert des valeurs imposées dans le second membre (elimination de lignes)
*
      subroutine transr(mchpo2,ri4,mchpo1)
*
*     mchpo2 : entree = second membre complet
*     ri4 : entree = matrice de relation
*     mchpo1 : sortie = increment du second membre
      IMPLICIT INTEGER(I-N)
*     IMPLICIT REAL*8 (A-H,O-Z)
*  pour le moment en cas de mode de fourier on suppose qu'il n'y en
*  n'a qu'un
-INC SMCHPOI
-INC SMRIGID
-INC CCOPTIO
-INC SMCOORD
-INC SMELEME
      segment trav
       real*8 val(nbnn)
      endsegment
*  exploser les flx
      nbnn=xcoor(/1)/(idim+1)
      segini trav
      segact mchpo2
      do 10 isoupo=1,mchpo2.ipchp(/1)
        msoupo=mchpo2.ipchp(isoupo)
        segact msoupo
        meleme=igeoc
        segact meleme
        do 20 ic=1,nocomp(/2)
          if (nocomp(ic).eq.'FLX ') goto 30
  20    continue
        goto 10
  30    continue
        mpoval=ipoval
        segact mpoval
        do 40 in=1,num(/2)
         val(num(1,in))=vpocha(in,ic)
  40    continue
  10  continue
*  on balaye les raideurs de dependances, on remplit le chpoin cible
      segact ri4
      nat=2
      nsoupo=0
      segini mchpo1
       mchpo1.mochde='créé par transr'
       mchpo1.ifopoi=mchpo2.ifopoi
       mchpo1.jattri(1)=2
      if (ri4.irigel(/1).lt.8) return
      do 100 irig=1,ri4.irigel(/2)
       if (ri4.irigel(8,irig).ne.0) then
         descr=ri4.irigel(3,irig)
         meleme=ri4.irigel(1,irig)
         Xmatri=ri4.irigel(4,irig)
         segact descr,meleme,Xmatri
         do 110 iligrp=1,lisinc(/2)
           if (lisinc(iligrp).eq.'LX  ') goto 120
 110     continue
         goto 100
 120     continue
         segact meleme
*  on a un lx a transferer
         nsoupo=nsoupo+1
         segadj mchpo1
         nc=1
         segini msoupo
         n=num(/2)
         nbnn=1
         nbelem=n
         nbref=0
         nbsous=0
         segini ipt1
         ipt1.itypel=1
         igeoc=ipt1
         nocomp(1)=lisinc(2)
         noharm(1)=ri4.irigel(5,irig)
         mchpo1.ipchp(nsoupo)=msoupo
         segini mpoval
         ipoval=mpoval
         do 130 i=1,n
*          xmatri=imattt(i)
          segact xmatri
          ip=num(noelep(2),i)
          ipt1.num(1,i)=ip
          ip1=num(noelep(1),i)
          vpocha(i,1)=val(ip1)/(re(1,2,i)*ri4.coerig(irig))
*          segdes xmatri
 130     continue
         segdes descr,meleme,xmatri
       endif
 100   continue
         segsup trav
*  toilettage de mchpo1
         call elchpo(mchpo1,iratt)
         end