C IDLIA1    SOURCE    CHAT      09/10/09    21:18:52     6519           
      SUBROUTINE IDLIA1(ipm,ipr,ipt)     
c identifie les liaisons : point + ddl d'un objet rigidite
c vis-à-vis d'un maillage
c range dans une table
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER(I-N)
      CHARACTER*4 motinc
-INC CCOPTIO
-INC SMRIGID
-INC SMTABLE
-INC SMELEME
      CHARACTER*4 MOPRIN(10)
      DATA MOPRIN / 'UX  ','UY  ','UZ  ','UR  ','UT  ',
     & 'RX  ','RY  ','RZ  ','RT  ','RS  ' /
      INTEGER lpilmo(10)
      segment pilmpoi(0)

      meleme = ipm 
      segact meleme
      if (itypel.ne.1) call change(ipm,1)
      meleme = ipm 
      mrigid = ipr
      segact meleme,mrigid
      call crtabl(ipt)
         CALL ECCTAB(ipt,'MOT',0,0.0D0,'SOUSTYPE',.TRUE.,0,
     & 'MOT',0,0.0D0,'LIAISONS_STATIQUES',.TRUE.,0)

      IM = 0
      do l= 1,10
        segini pilmpoi
        lpilmo(l) = pilmpoi
      enddo

      nrigel = coerig(/1)
      DO ire = 1,nrigel
        IPT1 = irigel(1,ire)
        segact ipt1
        leun = 1
        if (itypel.eq.22) leun = 2
        nbelem = ipt1.num(/2)
        descr = irigel(3,ire)
        segact descr
        NLIGRP = noelep(/1)
        DO iele = 1,nbelem
          DO igrp = leun,NLIGRP
            ino = noelep(igrp)
            IPOI = ipt1.num(ino,iele)
            motinc = lisinc(igrp)

        do jn = 1,num(/2)
            if (IPOI.eq.num(1,jn)) then
             do l = 1,10
              if (motinc.eq.moprin(l)) goto 21
             enddo
 20          write(6,*) ' ddl non traite ', motinc
             return
 21          pilmpoi = lpilmo(l)
             do ip = 1,pilmpoi(/1)             
              if (pilmpoi(ip).eq.IPOI) goto 91
             enddo
             pilmpoi(**) = IPOI

             IM = IM + 1
          call crtabl(iptab2)
          CALL ECCTAB(iptab2,'MOT',0,0.0D0,'POINT_LIAISON',.TRUE.,0,
     &        'POINT',0,0.0D0,' ',.TRUE.,IPOI)       
          CALL ECCTAB(iptab2,'MOT',0,0.0D0,'DDL_LIAISON',.TRUE.,0,
     &        'MOT',0,0.0D0,motinc,.TRUE.,0)       

          CALL ECCTAB(IPT,'ENTIER',IM,0.0D0,' ',.TRUE.,0,
     &        'TABLE',0,0.0D0,' ',.TRUE.,iptab2)       

             goto 91
            endif
        enddo
 91     continue
          ENDDO
        ENDDO
        segdes ipt1,descr

      ENDDO

      do io = 1,10
       pilmpoi = lpilmo(io)
       segsup pilmpoi
      enddo
      RETURN
      END