Télécharger la plaquette Cast3M


fr en

Télécharger bloqu2.eso

Retour à la liste

Numérotation des lignes : 

bloqu2

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

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