Télécharger reacti.eso

Retour à la liste

Numérotation des lignes :

  1. C REACTI SOURCE CB215821 19/08/20 21:21:25 10287
  2. SUBROUTINE REACTI
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. -INC CCOPTIO
  6. LOGICAL L0,L1
  7. CHARACTER*8 TYPRET,CTYP,CHARRE
  8. PARAMETER (IUN=1)
  9. *
  10. CALL LIRTAB('LIAISONS_STATIQUES',ITBAS,0,IRET)
  11.  
  12. CALL LIROBJ ('RIGIDITE',MRIGID,IUN,IRETOU)
  13. IF(IERR.NE.0) RETURN
  14. IF (IRET.NE.0) goto 1100
  15. *
  16. * lecture d'une TABLE ou d'un objet CHPOINT
  17. *
  18. CALL QUETYP(CTYP,0 ,IRETOU)
  19. IF(IRETOU.EQ.0) THEN
  20. CALL ERREUR(533)
  21. RETURN
  22. ENDIF
  23. IF (CTYP(1:8).EQ.'TABLE ') THEN
  24. CALL LIRTAB('BASE_MODALE',ITBAS,IUN,IRET)
  25. IF (IERR.NE.0) RETURN
  26. *
  27. * On r{cup}re la base des modes
  28. *
  29. CALL ACCTAB(ITBAS,'MOT',I0,X0,'MODES',L0,IP0,
  30. & 'TABLE',I1,X1,' ',L1,IBAS)
  31. IB = 0
  32. 10 CONTINUE
  33. TYPRET = ' '
  34. IB = IB + 1
  35. CALL ACCTAB(IBAS,'ENTIER',IB,X0,' ',L0,IP0,
  36. & TYPRET,I1,X1,CHARRE,L1,ITTBAS)
  37. IF (ITTBAS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  38. CALL ACCTAB(ITTBAS,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  39. & 'CHPOINT',I1,X1,' ',L1,MCHPOI)
  40. CALL REACT1(MRIGID,MCHPOI,MCHPO1)
  41. IF(IERR.NE.0) RETURN
  42. CALL ECCTAB(ITTBAS,'MOT',I0,X0,'REACTION_MODALE',L0,IP0,
  43. & 'CHPOINT',I1,X1,' ',L1,MCHPO1)
  44. GOTO 10
  45. ENDIF
  46. *
  47. * On r{cup}re la base des pseudo-modes
  48. *
  49. TYPRET = ' '
  50. CALL ACCTAB(ITBAS,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0,
  51. & TYPRET,I1,X1,CHARRE,L1,ITPS)
  52. IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  53. IB = 0
  54. 20 CONTINUE
  55. TYPRET = ' '
  56. IB = IB + 1
  57. CALL ACCTAB(ITPS,'ENTIER',IB,X0,' ',L0,IP0,
  58. & TYPRET,I1,X1,CHARRE,L1,ITTBAS)
  59. IF (ITTBAS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  60. CALL ACCTAB(ITTBAS,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  61. & 'CHPOINT',I1,X1,' ',L1,MCHPOI)
  62. CALL REACT1(MRIGID,MCHPOI,MCHPO1)
  63. IF(IERR.NE.0) RETURN
  64. CALL ECCTAB(ITTBAS,'MOT',I0,X0,'REACTION',L0,IP0,
  65. & 'CHPOINT',I1,X1,' ',L1,MCHPO1)
  66. GOTO 20
  67. ENDIF
  68. ENDIF
  69. CALL ECROBJ('TABLE ',ITBAS)
  70. RETURN
  71. ENDIF
  72. CALL LIROBJ ('CHPOINT ',MCHPOI,1,IRETOU)
  73. CALL ACTOBJ ('CHPOINT ',MCHPOI,1)
  74. IF(IERR.NE.0) RETURN
  75. CALL REACT1(MRIGID,MCHPOI,MCHPO1)
  76. IF(IERR.NE.0) RETURN
  77. CALL ACTOBJ('CHPOINT ',MCHPO1,1)
  78. CALL ECROBJ('CHPOINT ',MCHPO1)
  79. RETURN
  80. *
  81. 1100 CONTINUE
  82. IB = 0
  83. 1120 CONTINUE
  84. TYPRET = ' '
  85. IB = IB + 1
  86. CALL ACCTAB(ITBAS,'ENTIER',IB,X0,' ',L0,IP0,
  87. & TYPRET,I1,X1,CHARRE,L1,ITTBAS)
  88. IF (ITTBAS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  89. IF (MRIGID.GT.0) THEN
  90. CALL ACCTAB(ITTBAS,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  91. & 'CHPOINT',I1,X1,' ',L1,MCHPOI)
  92. CALL REACT1(MRIGID,MCHPOI,MCHPO1)
  93. IF(IERR.NE.0) RETURN
  94. CALL ECCTAB(ITTBAS,'MOT',I0,X0,'REACTION',L0,IP0,
  95. & 'CHPOINT',I1,X1,' ',L1,MCHPO1)
  96. ENDIF
  97. GOTO 1120
  98. ENDIF
  99.  
  100. CALL ECROBJ('TABLE ',ITBAS)
  101. RETURN
  102. END
  103.  
  104.  
  105.  

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