C RICRO1    SOURCE    KICH      11/08/11    21:15:48     7079           
      SUBROUTINE RICRO1(ipv1,ipv2,ibu,ibd,mot2,irig,iinc,idua,xr1)
* produit scalaire proprement dit
      IMPLICIT REAL*8(A-H,O-Z)
-INC CCOPTIO
-INC SMCHAML
-INC SMLMOTS
c
      SEGMENT MPTVAL
      INTEGER IPOS(NS),NSOF(NS)
      INTEGER IVAL(NCOSOU)
      CHARACTER*16 TYVAL(NCOSOU)
      ENDSEGMENT
C
      CHARACTER*4 mot2

      xr1 = 0.d0
      mptval = ipv1
      segact mptval
      if (irig.eq.1) then
*masse
       melval = ival(3)
       segact melval
       IBMN=MIN(IBU,IELCHE(/2))
       itreac = ielche(1,ibmn)
       segdes melval
      elseif (irig.eq.2) then
* rigidite
       melval = ival(2)
       segact melval
       IBMN=MIN(IBU,IELCHE(/2))
       itreac = ielche(1,ibmn)
       segdes melval
*
      elseif (irig.eq.3) then
         xamorsta = 0.
       if(ival(/1).gt.3) then
        melval = ival(4)
        if (melval.gt.0) then
          segact melval
          IBMN=MIN(IBU,VELCHE(/2))
          xamorsta = velche(1,ibmn)
          segdes melval
*comme pour masse
       melval = ival(3)
       segact melval
       IBMN=MIN(IBU,IELCHE(/2))
       itreac = ielche(1,ibmn)
       segdes melval
        endif
       endif
*
      endif

      if (ipv1.ne.ipv2) then
         segdes mptval
         mptval = ipv2
         segact mptval
      endif

*masse ou rigidite
       if (mot2.eq.'STAT') then
        melval = ival(1)
       elseif (mot2.eq.'MODA') then
        melval = ival(3)
       endif
       segact melval
       IBMN=MIN(IBD,IELCHE(/2))
       itdepl = ielche(1,ibmn)
       segdes melval
*
       if (irig.eq.3) then
          xamo2 = 0.
        if(ival(/1).gt.3) then
         melval = ival(4)
         if (melval.gt.0) then
          segact melval
          IBMN=MIN(IBD,VELCHE(/2))
          xamo2 = velche(1,ibmn)
          segdes melval
         endif
        endif
        xamo3 = xamorsta*xamo2
         if (xamo3.eq.0.) then
          xr1 = 0.
          return
         else
          xamo = dsqrt(dabs(xamo3))
          if (xamo3.lt.0) xamo = xamo * (-1.d0)
         endif
       endif



         CALL XTY1(itdepl,itreac,iinc,idua,XR1)  
         if (ierr.ne.0) return
         if (irig.eq.3) xr1 = xr1 * xamo

      RETURN
      END