C RICROI    SOURCE    PV090527  26/04/30    21:16:17     12529          
      SUBROUTINE RICROI(modsta,ir2,irig)
*--calcul termes croisés 'STATIQUE' et/ou 'MODAL'
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
-INC CCREEL
-INC SMRIGID
-INC SMCOORD
-INC SMCHAML
-INC SMELEME
-INC SMLMOTS
-INC SMMODEL
c
      segment modsta
       integer pimoda(nmoda),pistat(nstat)
       integer ivmoda(nmoda),ivstat(nstat)
      endsegment
      CHARACTER*4 lesinc(7),lesdua(7),mot2
      DATA lesinc/'UX','UY','UZ','RX','RY','RZ','UR'/
      DATA lesdua/'FX','FY','FZ','MX','MY','MZ','FR'/

      ir2 = 0
      nstat = pistat(/1)
      nmoda = pimoda(/1)

      jgn = 4
      jgm = 6
      segini mlmots
      iinc = mlmots
      do igm = 1,jgm
       mots(igm) = lesinc(igm)
      enddo
      segini mlmots
      idua = mlmots
      do igm= 1,jgm
       mots(igm) = lesdua(igm)
      enddo

      nelrig = 100
* 'STATIQUE'/'STATIQUE' : 1 * 'STATIQUE'/'MODAL' : 2
      nelri1 = nelrig
      nelri2 = nelrig
      kelri1 = 0
      kelri2 = 0
          nligrd = 2
      nligrp = 2
      rigrel=0
      segini xmatr1,xmatr2
      NBELEM = nelrig
      NBNN = 2
      NBSOUS = 0
      NBREF = 0
      SEGINI IPT1,IPT2
      IPT1.ITYPEL=27
      IPT2.ITYPEL=27
      NBELE1 = NELRI1
      NBELE2 = NELRI2
*
*
      DO is = 1,nstat

        imodel = pistat(is)
        segact imodel
        ipt4 = imamod
        segact ipt4
        if (ipt4.num(/1).ne.1) call erreur(5)
        nbelem = ipt4.num(/2)
* en principe on ne devrait pas trop boucler
        do ib = 1,nbelem
         if (nbelem.gt.1) then
          do ib1 = ib+1 , nbelem
             iv1 = ivstat(is)
             iv2 = ivstat(is)
         call ricro1(iv1,iv2,ib,ib1,'STAT',irig,iinc,idua,xr1)
            if (ABS(xr1).lt.xspeti) goto 21
            kelri1 = kelri1 + 1
*            segini xmatri
            xmatr1.re(2,1,kelri1) = xr1
            xmatr1.re(1,2,kelri1) = xmatr1.re(2,1,kelri1)
*            imatr1.imattt(kelri1) = xmatri
* cree segment ib- ib1
            ipt1.num(1,kelri1) = ipt4.num(1,ib)
            ipt1.num(2,kelri1) = ipt4.num(1,ib1)
            if (kelri1.eq.nelri1) then
              nelrig = nelri1 + 100
              nelri1 = nelrig
              rigrel=0
              segadj xmatr1
              nbelem = nelrig
              segadj ipt1
              NBELE1 = NELRI1
            endif
 21         continue
          enddo
         endif


         IF (IS.LT.NSTAT) THEN
          DO is2 = is + 1 ,nstat
           imode2 = pistat(is2)
           segact imode2
           ipt5 = imode2.imamod
           segact ipt5
           if (ipt5.num(/1).ne.1) call erreur(6)
           nbele2 = ipt5.num(/2)
           do ib2 = 1,nbele2
             iv1 = ivstat(is)
             iv2 = ivstat(is2)
         call ricro1(iv1,iv2,ib,ib2,'STAT',irig,iinc,idua,xr1)
            if (ABS(xr1).lt.xspeti) goto 22
            kelri1 = kelri1 + 1
*            segini xmatri
            xmatr1.re(2,1,kelri1) = xr1
            xmatr1.re(1,2,kelri1) = xmatr1.re(2,1,kelri1)
*            imatr1.imattt(kelri1) = xmatri
* cree segment ib- ib2
            ipt1.num(1,kelri1) = ipt4.num(1,ib)
            ipt1.num(2,kelri1) = ipt5.num(1,ib2)
            if (kelri1.eq.nelri1) then
              nelrig = nelri1 + 100
              nelri1 = nelrig
              rigrel=0
              segadj xmatr1
              nbelem = nelrig
              segadj ipt1
              NBELE1 = NELRI1
            endif
 22         continue
           enddo
          ENDDO
         ENDIF

*

         DO im = 1, nmoda
           imode1 = pimoda(im)
           segact imode1
           ipt3 = imode1.imamod
           segact ipt3
           if (ipt3.num(/1).ne.1) call erreur(7)
           nbele3 = ipt3.num(/2)
           do ib3 = 1,nbele3
            iv1 = ivstat(is)
            iv2 = ivmoda(im)
         call ricro1(iv1,iv2,ib,ib3,'MODA',irig,iinc,idua,xr1)
            if (ABS(xr1).lt.xspeti) goto 23
            kelri2 = kelri2 + 1
*            segini xmatri
            xmatr2.re(2,1,kelri2) = xr1
            xmatr2.re(1,2,kelri2) = xmatr2.re(2,1,kelri2)
*            imatr2.imattt(kelri2) = xmatri
* cree segment ib- ib3
            ipt2.num(1,kelri2) =  ipt3.num(1,ib3)
            ipt2.num(2,kelri2) =  ipt4.num(1,ib)
            if (kelri2.eq.nelri2) then
              nelrig = nelri2 + 100
              nelri2 = nelrig
              rigrel=0
              segadj xmatr2
              nbelem = nelrig
              segadj ipt2
              NBELE2 = NELRI2
            endif
 23         continue
           enddo

         ENDDO
        enddo

      ENDDO

 100  continue
      NRIGE = 8
      NRIGEL = 1
      irstat = 0
      irmoda = 0
      if (nstat.gt.1) then
      nbelem = kelri1
      SEGADJ IPT1
      NELRIG=NBELEM
      rigrel=0
      SEGADJ xMATR1
      SEGINI DESCR
      NOELEP(1)=1
      NOELEP(2)=2
      NOELED(1)=1
      NOELED(2)=2
      LISINC(1)='BETA'
      LISINC(2)='BETA'
      LISDUA(1)='FBET'
      LISDUA(2)='FBET'
      SEGDES DESCR
      segini mrigid
      irstat = mrigid
      irigel(1,1) = ipt1
      irigel(3,1) = descr
      IRIGEL(4,1) = xMATR1
      IFORIG = IFOUR
      COERIG(1) = 1.D0
      IMGEO1 = 0
      IMGEO2 = 0
      ICHOLE = 0
      ISUPEQ = 0
      if (irig.eq.1) then
        MTYMAT = 'MASSE   '
      elseif (irig.eq.2) then
        MTYMAT = 'RIGIDITE'
      elseif (irig.eq.3) then
        MTYMAT = 'AMORTISS'
      endif
*
      IRIGEL(2,1) = 0
      IRIGEL(5,1) = NIFOUR
      IRIGEL(6,1) = 0
      endif

      if (nmoda.gt.0) then
      nbelem = kelri2
      SEGADJ IPT2
      NELRIG=NBELEM
      rigrel=0
      SEGADJ xMATR2
      SEGINI DESCR
      NOELEP(1)=1
      NOELEP(2)=2
      NOELED(1)=1
      NOELED(2)=2
      LISINC(1)='ALFA'
      LISINC(2)='BETA'
      LISDUA(1)='FALF'
      LISDUA(2)='FBET'
      SEGDES DESCR
      segini mrigid
      irmoda = mrigid
      irigel(1,1) = ipt2
      irigel(3,1) = descr
      IRIGEL(4,1) = xMATR2
      IFORIG = IFOUR
      COERIG(1) = 1.D0
      IMGEO1 = 0
      IMGEO2 = 0
      ICHOLE = 0
      ISUPEQ = 0
      if (irig.eq.1) then
        MTYMAT = 'MASSE   '
      elseif (irig.eq.2) then
        MTYMAT = 'RIGIDITE'
      endif
*
      IRIGEL(2,1) = 0
      IRIGEL(5,1) = NIFOUR
      IRIGEL(6,1) = 0
      endif

      if (irmoda.eq.0) then
       ir2 = irstat
      else if (irstat.eq.0) then
       ir2 = irmoda
      else
       call fusrig(irstat,irmoda, ir2)
      endif

      mlmots = iinc
      segsup mlmots
      mlmots = idua
      segsup mlmots

      END