Télécharger reacti.eso

Retour à la liste

Numérotation des lignes :

  1. C REACTI SOURCE KICH 07/11/15 21:15:18 5970
  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,IUN,IRETOU)
  73. IF(IERR.NE.0) RETURN
  74. CALL REACT1(MRIGID,MCHPOI,MCHPO1)
  75. IF(IERR.NE.0) RETURN
  76. CALL ECROBJ('CHPOINT ',MCHPO1)
  77. RETURN
  78. *
  79. 1100 CONTINUE
  80. IB = 0
  81. 1120 CONTINUE
  82. TYPRET = ' '
  83. IB = IB + 1
  84. CALL ACCTAB(ITBAS,'ENTIER',IB,X0,' ',L0,IP0,
  85. & TYPRET,I1,X1,CHARRE,L1,ITTBAS)
  86. IF (ITTBAS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  87. IF (MRIGID.GT.0) THEN
  88. CALL ACCTAB(ITTBAS,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  89. & 'CHPOINT',I1,X1,' ',L1,MCHPOI)
  90. CALL REACT1(MRIGID,MCHPOI,MCHPO1)
  91. IF(IERR.NE.0) RETURN
  92. CALL ECCTAB(ITTBAS,'MOT',I0,X0,'REACTION',L0,IP0,
  93. & 'CHPOINT',I1,X1,' ',L1,MCHPO1)
  94. ENDIF
  95. GOTO 1120
  96. ENDIF
  97.  
  98. CALL ECROBJ('TABLE ',ITBAS)
  99. RETURN
  100. END
  101.  
  102.  
  103.  
  104.  
  105.  

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