Esope source files

   1 : C IDLIA1    SOURCE    CHAT      09/10/09    21:18:52     6519           
   2 :       SUBROUTINE IDLIA1(ipm,ipr,ipt)     
   3 : c identifie les liaisons : point + ddl d'un objet rigidite
   4 : c vis-à-vis d'un maillage
   5 : c range dans une table
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 :       IMPLICIT INTEGER(I-N)
   8 :       CHARACTER*4 motinc
   9 : -INC CCOPTIO
  10 : -INC SMRIGID
  11 : -INC SMTABLE
  12 : -INC SMELEME
  13 :       CHARACTER*4 MOPRIN(10)
  14 :       DATA MOPRIN / 'UX  ','UY  ','UZ  ','UR  ','UT  ',
  15 :      & 'RX  ','RY  ','RZ  ','RT  ','RS  ' /
  16 :       INTEGER lpilmo(10)
  17 :       segment pilmpoi(0)
  18 : 
  19 :       meleme = ipm 
  20 :       segact meleme
  20 :       if (itypel.ne.1) call change(ipm,1)
  21 :       meleme = ipm 
  22 :       mrigid = ipr
  23 :       segact meleme,mrigid
  23 :       call crtabl(ipt)
  23 :          CALL ECCTAB(ipt,'MOT',0,0.0D0,'SOUSTYPE',.TRUE.,0,
  24 :      & 'MOT',0,0.0D0,'LIAISONS_STATIQUES',.TRUE.,0)
  25 : 
  26 :       IM = 0
  27 :       do l= 1,10
  28 :         segini pilmpoi
  29 :         lpilmo(l) = pilmpoi
  30 :       enddo
  31 : 
  32 :       nrigel = coerig(/1)
  33 :       DO ire = 1,nrigel
  34 :         IPT1 = irigel(1,ire)
  35 :         segact ipt1
  36 :         leun = 1
  37 :         if (itypel.eq.22) leun = 2
  38 :         nbelem = ipt1.num(/2)
  39 :         descr = irigel(3,ire)
  40 :         segact descr
  41 :         NLIGRP = noelep(/1)
  42 :         DO iele = 1,nbelem
  43 :           DO igrp = leun,NLIGRP
  44 :             ino = noelep(igrp)
  45 :             IPOI = ipt1.num(ino,iele)
  46 :             motinc = lisinc(igrp)
  47 : 
  48 :         do jn = 1,num(/2)
  49 :             if (IPOI.eq.num(1,jn)) then
  50 :              do l = 1,10
  51 :               if (motinc.eq.moprin(l)) goto 21
  52 :              enddo
  53 :  20          write(6,*) ' ddl non traite ', motinc
  54 :              return
  55 :  21          pilmpoi = lpilmo(l)
  56 :              do ip = 1,pilmpoi(/1)             
  57 :               if (pilmpoi(ip).eq.IPOI) goto 91
  58 :              enddo
  59 :              pilmpoi(**) = IPOI
  60 : 
  61 :              IM = IM + 1
  61 :           call crtabl(iptab2)
  61 :           CALL ECCTAB(iptab2,'MOT',0,0.0D0,'POINT_LIAISON',.TRUE.,0,
  62 :      &        'POINT',0,0.0D0,' ',.TRUE.,IPOI)       
  62 :           CALL ECCTAB(iptab2,'MOT',0,0.0D0,'DDL_LIAISON',.TRUE.,0,
  63 :      &        'MOT',0,0.0D0,motinc,.TRUE.,0)       
  64 : 
  64 :           CALL ECCTAB(IPT,'ENTIER',IM,0.0D0,' ',.TRUE.,0,
  65 :      &        'TABLE',0,0.0D0,' ',.TRUE.,iptab2)       
  66 : 
  67 :              goto 91
  68 :             endif
  69 :         enddo
  70 :  91     continue
  71 :           ENDDO
  72 :         ENDDO
  73 :         segdes ipt1,descr
  74 : 
  75 :       ENDDO
  76 : 
  77 :       do io = 1,10
  78 :        pilmpoi = lpilmo(io)
  79 :        segsup pilmpoi
  80 :       enddo
  81 :       RETURN
  82 :       END
  83 :  
  84 :  
  85 :