C BLOQU2    SOURCE    KICH      07/11/15    21:15:02     5970           
      SUBROUTINE BLOQU2(IPT)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC SMTABLE
-INC CCOPTIO
      segment lispoi
       INTEGER pilpoi(mpoin),pilmul(mpoin)
      endsegment
      CHARACTER*4 MOTPV(3),charre          
      CHARACTER*4 MODEPL(6),MODEDU(6)
      CHARACTER*4 MOPRIN(10),MODUAL(10)
      CHARACTER*4 MOROTA(5),MORODU(5)
      DATA MODEPL / 'UX  ','UY  ','UZ  ','UR  ','UZ  ','UT  ' /
      DATA MODEDU / 'FX  ','FY  ','FZ  ','FR  ','FZ  ','FT  ' /
      DATA MOROTA / 'RX  ','RY  ','RZ  ','RT  ','RS  ' /
      DATA MORODU / 'MX  ','MY  ','MZ  ','MT  ','MS  ' /

      do ii = 1,4
        moprin(ii) = modepl(ii)
        modual(ii) = modedu(ii)
      enddo
        moprin(5) = modepl(6) 
        modual(5) = modedu(6) 
      do ii = 1,5
        moprin(5+ii) = morota(ii)
        modual(5+ii) = morodu(ii)
      enddo
      krig = 0
      mtable = ipt
      segact mtable
      ima = mlotab - 1 
      if (ima.eq.1) RETURN 
      DO kmo = 1,10
        mpoin = 50
        kpoin = 0
        segini lispoi
        do im = 1,ima
           CALL ACCTAB(IPT,'ENTIER',IM,0.d0,' ',.true.,IP0,
     &                   'TABLE',I1,X1,CHARRE,.true.,ITMOD)
           if (ierr.ne.0) return
           CALL ACCTAB(ITMOD,'MOT',I0,X0,'DDL_LIAISON',.true.,IP0,
     &                      'MOT',I1,X1,charre,.true.,IPTS)
           if (ierr.ne.0) return
          IF (charre.eq.moprin(kmo)) THEN
           CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_LIAISON',.true.,IP0,
     &                      'POINT',I1,X1,charre,.true.,IPTS)
           if (ierr.ne.0) return
c
c
            do ik = 1,kpoin
              if (ipts.eq.pilpoi(ik)) then
c          write(6,*)'combinaison point -ddl déjà traitée', ipts,charre
               goto 1120
              endif
            enddo 
            kpoin = kpoin + 1

            if (kpoin.gt.mpoin) then
              mpoin = mpoin + 50
              segadj lispoi
            endif
            pilpoi(kpoin) = IPTS

           call ecrcha(charre)
           call ecrobj('POINT',IPTS)
           call bloque
           call lirobj('RIGIDITE',ir1, 1,iretou)
           if(ierr.ne.0) return
           CALL ECCTAB(ITMOD,'MOT',0,0.0D0,'BLOCAGE',.TRUE.,IPO,
     &        'RIGIDITE',0,0.0D0,' ',.TRUE.,ir1)
           krig = krig + 1
           if (krig.eq.1) then 
              ir2 = ir1
           else
              call fusrig(ir1,ir2,irt)
              if (ierr.ne.0) return
             ir2 = irt
           endif    

          ENDIF 
 1120     continue
        enddo
        if (kpoin.eq.0) goto 1130
 
 1130   segsup lispoi
      ENDDO


      CALL ECROBJ('RIGIDITE',ir2)

      RETURN
     
      END