C BLOQU2    SOURCE    BP208322  17/09/15    21:15:01     9548           
      SUBROUTINE BLOQU2(IPT)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC SMTABLE

-INC PPARAM
-INC CCOPTIO
cbp   ON SUPPOSE QUE LA TABLE EST BIEN DECRITE
cbp   ET ON COMMENTE TOUS LES TEST INUTILES
cbp   segment lispoi
cbp    INTEGER pilpoi(mpoin),pilmul(mpoin)
cbp   endsegment

cbp   CHARACTER*4 MOTPV(3)
      CHARACTER*4 charre
      CHARACTER*8 TYPRET
cbp c on autorise les ddl mecanique + thermique + liquide
cbp   PARAMETER (NPRIN=15)
cbp   CHARACTER*4 MOPRIN(NPRIN)
cbp   DATA MOPRIN / 'UX  ','UY  ','UZ  ','UR  ','UT  ',
cbp  &              'RX  ','RY  ','RZ  ','RT  ','P   ','PI  ',
cbp  &              'T   ','RR  ','TINF','TSUP'/
cbp   DATA MODUAL / 'FX  ','FY  ','FZ  ','FR  ','FT  ',
cbp  &              'MX  ','MY  ','MZ  ','MT  ','FP  ','FPI ',
cbp  &              'Q   ','MR  ','QINF','QSUP'/

      krig = 0
      IPO  = 0
      mtable = ipt
      segact mtable
      ima = mlotab - 1
      IF (ima.eq.0) RETURN
cbp   DO kmo = 1,NPRIN
cbp     mpoin = 50
cbp     kpoin = 0
cbp     segini lispoi
cbp        DO im = 1,ima
        DO 10 im = 1,ima
           TYPRET=' '
           CALL ACCTAB(IPT,'ENTIER',IM,0.d0,' ',.true.,IP0,
     &                   TYPRET,I1,X1,CHARRE,.true.,ITMOD)
           IF(TYPRET.ne.'TABLE') GOTO 10
           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
cbp       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
cbp         do ik = 1,kpoin
cbp           if (ipts.eq.pilpoi(ik)) then
cbp c     write(6,*)'combinaison point -ddl déjà traitée', ipts,charre
cbp            goto 10
cbp           endif
cbp         enddo
cbp         kpoin = kpoin + 1

cbp         if (kpoin.gt.mpoin) then
cbp           mpoin = mpoin + 50
cbp           segadj lispoi
cbp         endif
cbp         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
cbp               call fusrig(ir1,ir2,irt)
              call fusrig(ir2,ir1,irt)
              if (ierr.ne.0) return
             ir2 = irt
           endif

cbp           ENDIF
 10     CONTINUE
cbp        ENDDO
cbp     if (kpoin.eq.0) goto 1130
c
c  1130   segsup lispoi
cbp   ENDDO


      CALL ECROBJ('RIGIDITE',ir2)

      RETURN

      END