Télécharger bloqu2.eso

Retour à la liste

Numérotation des lignes :

  1. C BLOQU2 SOURCE CB215821 16/04/15 21:15:04 8907
  2. SUBROUTINE BLOQU2(IPT)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. -INC SMTABLE
  6. -INC CCOPTIO
  7. cbp ON SUPPOSE QUE LA TABLE EST BIEN DECRITE
  8. cbp ET ON COMMENTE TOUS LES TEST INUTILES
  9. cbp segment lispoi
  10. cbp INTEGER pilpoi(mpoin),pilmul(mpoin)
  11. cbp endsegment
  12.  
  13. cbp CHARACTER*4 MOTPV(3)
  14. CHARACTER*4 charre
  15. cbp c on autorise les ddl mecanique + thermique + liquide
  16. cbp PARAMETER (NPRIN=15)
  17. cbp CHARACTER*4 MOPRIN(NPRIN)
  18. cbp DATA MOPRIN / 'UX ','UY ','UZ ','UR ','UT ',
  19. cbp & 'RX ','RY ','RZ ','RT ','P ','PI ',
  20. cbp & 'T ','RR ','TINF','TSUP'/
  21. cbp DATA MODUAL / 'FX ','FY ','FZ ','FR ','FT ',
  22. cbp & 'MX ','MY ','MZ ','MT ','FP ','FPI ',
  23. cbp & 'Q ','MR ','QINF','QSUP'/
  24.  
  25. krig = 0
  26. IPO = 0
  27. mtable = ipt
  28. segact mtable
  29. ima = mlotab - 1
  30. IF (ima.eq.1) RETURN
  31. cbp DO kmo = 1,NPRIN
  32. cbp mpoin = 50
  33. cbp kpoin = 0
  34. cbp segini lispoi
  35. cbp DO im = 1,ima
  36. DO 10 im = 1,ima
  37. CALL ACCTAB(IPT,'ENTIER',IM,0.d0,' ',.true.,IP0,
  38. & 'TABLE',I1,X1,CHARRE,.true.,ITMOD)
  39. 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. cbp IF (charre.eq.moprin(kmo)) THEN
  44. CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_LIAISON',.true.,IP0,
  45. & 'POINT',I1,X1,charre,.true.,IPTS)
  46. IF (IERR.NE.0) RETURN
  47. c
  48. c
  49. cbp do ik = 1,kpoin
  50. cbp if (ipts.eq.pilpoi(ik)) then
  51. cbp c write(6,*)'combinaison point -ddl déjà traitée', ipts,charre
  52. cbp goto 10
  53. cbp endif
  54. cbp enddo
  55. cbp kpoin = kpoin + 1
  56.  
  57. cbp if (kpoin.gt.mpoin) then
  58. cbp mpoin = mpoin + 50
  59. cbp segadj lispoi
  60. cbp endif
  61. cbp pilpoi(kpoin) = IPTS
  62.  
  63. CALL ECRCHA(charre)
  64. CALL ECROBJ('POINT',IPTS)
  65. CALL BLOQUE
  66. CALL LIROBJ('RIGIDITE',ir1, 1,iretou)
  67. IF(IERR.NE.0) RETURN
  68. CALL ECCTAB(ITMOD,'MOT',0,0.0D0,'BLOCAGE',.TRUE.,IPO,
  69. & 'RIGIDITE',0,0.0D0,' ',.TRUE.,ir1)
  70. krig = krig + 1
  71. if (krig.eq.1) then
  72. ir2 = ir1
  73. else
  74. cbp call fusrig(ir1,ir2,irt)
  75. call fusrig(ir2,ir1,irt)
  76. if (ierr.ne.0) return
  77. ir2 = irt
  78. endif
  79.  
  80. cbp ENDIF
  81. 10 CONTINUE
  82. cbp ENDDO
  83. cbp if (kpoin.eq.0) goto 1130
  84. c
  85. c 1130 segsup lispoi
  86. cbp ENDDO
  87.  
  88.  
  89. CALL ECROBJ('RIGIDITE',ir2)
  90.  
  91. RETURN
  92.  
  93. END
  94.  
  95.  
  96.  
  97.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales