Esope source files

   1 : C BLOQU2    SOURCE    KICH      07/11/15    21:15:02     5970           
   2 :       SUBROUTINE BLOQU2(IPT)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : -INC SMTABLE
   6 : -INC CCOPTIO
   7 :       segment lispoi
   8 :        INTEGER pilpoi(mpoin),pilmul(mpoin)
   9 :       endsegment
  10 :       CHARACTER*4 MOTPV(3),charre          
  11 :       CHARACTER*4 MODEPL(6),MODEDU(6)
  12 :       CHARACTER*4 MOPRIN(10),MODUAL(10)
  13 :       CHARACTER*4 MOROTA(5),MORODU(5)
  14 :       DATA MODEPL / 'UX  ','UY  ','UZ  ','UR  ','UZ  ','UT  ' /
  15 :       DATA MODEDU / 'FX  ','FY  ','FZ  ','FR  ','FZ  ','FT  ' /
  16 :       DATA MOROTA / 'RX  ','RY  ','RZ  ','RT  ','RS  ' /
  17 :       DATA MORODU / 'MX  ','MY  ','MZ  ','MT  ','MS  ' /
  18 : 
  19 :       do ii = 1,4
  20 :         moprin(ii) = modepl(ii)
  21 :         modual(ii) = modedu(ii)
  22 :       enddo
  23 :         moprin(5) = modepl(6) 
  24 :         modual(5) = modedu(6) 
  25 :       do ii = 1,5
  26 :         moprin(5+ii) = morota(ii)
  27 :         modual(5+ii) = morodu(ii)
  28 :       enddo
  29 :       krig = 0
  30 :       mtable = ipt
  31 :       segact mtable
  32 :       ima = mlotab - 1 
  33 :       if (ima.eq.1) RETURN 
  34 :       DO kmo = 1,10
  35 :         mpoin = 50
  36 :         kpoin = 0
  37 :         segini lispoi
  38 :         do im = 1,ima
  38 :            CALL ACCTAB(IPT,'ENTIER',IM,0.d0,' ',.true.,IP0,
  39 :      &                   'TABLE',I1,X1,CHARRE,.true.,ITMOD)
  40 :            if (ierr.ne.0) return
  40 :            CALL ACCTAB(ITMOD,'MOT',I0,X0,'DDL_LIAISON',.true.,IP0,
  41 :      &                      'MOT',I1,X1,charre,.true.,IPTS)
  42 :            if (ierr.ne.0) return
  43 :           IF (charre.eq.moprin(kmo)) THEN
  43 :            CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_LIAISON',.true.,IP0,
  44 :      &                      'POINT',I1,X1,charre,.true.,IPTS)
  45 :            if (ierr.ne.0) return
  46 : c
  47 : c
  48 :             do ik = 1,kpoin
  49 :               if (ipts.eq.pilpoi(ik)) then
  50 : c          write(6,*)'combinaison point -ddl déjà traitée', ipts,charre
  51 :                goto 1120
  52 :               endif
  53 :             enddo 
  54 :             kpoin = kpoin + 1
  55 : 
  56 :             if (kpoin.gt.mpoin) then
  57 :               mpoin = mpoin + 50
  58 :               segadj lispoi
  59 :             endif
  60 :             pilpoi(kpoin) = IPTS
  61 : 
  61 :            call ecrcha(charre)
  61 :            call ecrobj('POINT',IPTS)
  61 :            call bloque
  61 :            call lirobj('RIGIDITE',ir1, 1,iretou)
  62 :            if(ierr.ne.0) return
  62 :            CALL ECCTAB(ITMOD,'MOT',0,0.0D0,'BLOCAGE',.TRUE.,IPO,
  63 :      &        'RIGIDITE',0,0.0D0,' ',.TRUE.,ir1)
  64 :            krig = krig + 1
  65 :            if (krig.eq.1) then 
  66 :               ir2 = ir1
  67 :            else
  67 :               call fusrig(ir1,ir2,irt)
  68 :               if (ierr.ne.0) return
  69 :              ir2 = irt
  70 :            endif    
  71 : 
  72 :           ENDIF 
  73 :  1120     continue
  74 :         enddo
  75 :         if (kpoin.eq.0) goto 1130
  76 :  
  77 :  1130   segsup lispoi
  78 :       ENDDO
  79 : 
  80 : 
  80 :       CALL ECROBJ('RIGIDITE',ir2)
  81 : 
  82 :       RETURN
  83 :      
  84 :       END
  85 :