Télécharger rccont.eso

Retour à la liste

Numérotation des lignes :

  1. C RCCONT SOURCE FANDEUR 10/12/14 21:19:11 6812
  2. SUBROUTINE RCCONT(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. * *
  7. * Recombine le chpoint ICHPT en contrainte. *
  8. * *
  9. * Param}tres: *
  10. * *
  11. * e ITBAS table repr{sentant une base modale *
  12. * e ICHPT chpoint modal @ recombiner *
  13. * e KCHAR chargement de la structure *
  14. * e XTEMP temps de recombinaison *
  15. * e ITRES table r{sultat issue de l'op{rateur DYNE *
  16. * e IPOS position de XTEMP dans le listreel des temps *
  17. * e ITLIA table des liaisons *
  18. * *
  19. * Auteur, date de cr{ation: *
  20. * *
  21. * Lionel VIVAN, le 26 avril 1990. *
  22. * *
  23. *--------------------------------------------------------------------*
  24. -INC CCOPTIO
  25. -INC SMCHPOI
  26. -INC SMELEME
  27. -INC SMCOORD
  28. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  29. SEGMENT TRAV(NPOIN)*D
  30. LOGICAL L0,L1
  31. CHARACTER*8 TYPRET,CHARRE
  32. CHARACTER*40 TYPBAS
  33. *
  34. * on met les contributions modales ICHPT dans ICPR et TRAV
  35. *
  36. MCHPOI = ICHPT
  37. IF (MCHPOI.EQ.0) THEN
  38. * le CHPOINT des contributions modales est nul
  39. MOTERR(1:8) = 'RCCONT'
  40. CALL ERREUR(170)
  41. RETURN
  42. ENDIF
  43. SEGINI ICPR
  44. KCPR = ICPR
  45. SEGACT MCHPOI
  46. NSOU = IPCHP(/1)
  47. IKI = 0
  48. DO 10 ISOU = 1,NSOU
  49. MSOUPO = IPCHP(ISOU)
  50. SEGACT MSOUPO
  51. * on cherche un CHPOINT qui contient des contributions modales
  52. IF (NOCOMP(/2).NE.1) THEN
  53. CALL ERREUR(188)
  54. SEGDES MSOUPO
  55. SEGDES MCHPOI
  56. GOTO 991
  57. ENDIF
  58. IF (NOCOMP(1).NE.'ALFA') THEN
  59. CALL ERREUR(188)
  60. SEGDES MSOUPO
  61. SEGDES MCHPOI
  62. GOTO 991
  63. ENDIF
  64. MELEME = IGEOC
  65. SEGACT MELEME
  66. N2 = NUM(/2)
  67. DO 12 I = 1,N2
  68. IKI = IKI + 1
  69. ICPR(NUM(1,I)) = IKI
  70. 12 CONTINUE
  71. SEGDES MELEME,MSOUPO
  72. 10 CONTINUE
  73. NPOIN = IKI
  74. SEGINI TRAV
  75. KTRAV = TRAV
  76. IKI = 0
  77. DO 20 ISOU = 1,NSOU
  78. MSOUPO = IPCHP(ISOU)
  79. SEGACT MSOUPO
  80. MPOVAL = IPOVAL
  81. SEGACT MPOVAL
  82. N2 = VPOCHA(/1)
  83. DO 22 I = 1,N2
  84. IKI = IKI + 1
  85. TRAV(IKI) = VPOCHA(I,1)
  86. 22 CONTINUE
  87. SEGDES MPOVAL,MSOUPO
  88. 20 CONTINUE
  89. SEGDES MCHPOI
  90. *
  91. CALL ACCTAB(ITBAS,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  92. & 'MOT',I1,X1,TYPBAS,L1,IP1)
  93. *
  94. * Cas oº la base est unique
  95. *
  96. IF (TYPBAS(1:11).EQ.'BASE_MODALE') THEN
  97. CALL RCCON2(ITBAS,KTRAV,KCPR,KCHAR,XTEMP,ICHCO,ITRES,IPOS,
  98. & ITLIA)
  99. IF (IERR.NE.0) GOTO 990
  100. *
  101. * Cas oº on a un ensemble de bases
  102. *
  103. ELSE IF (TYPBAS(1:17).EQ.'ENSEMBLE_DE_BASES') THEN
  104. *
  105. * On boucle sur le nombre de bases
  106. *
  107. IB = 0
  108. 30 CONTINUE
  109. TYPRET = ' '
  110. IB = IB + 1
  111. CALL ACCTAB(ITBAS,'ENTIER',IB,X0,' ',L0,IP0,
  112. & TYPRET,I1,X1,CHARRE,L1,ITTBAS)
  113. IF (ITTBAS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  114. CALL RCCON2(ITTBAS,KTRAV,KCPR,KCHAR,XTEMP,IRET,ITRES,IPOS,
  115. & ITLIA)
  116. IF (IERR.NE.0) GOTO 990
  117. IF (IB.EQ.1) THEN
  118. ICHCO = IRET
  119. ELSE
  120. N1 = 1
  121. CALL ADCHEL(ICHCO,IRET,ICHCO,N1)
  122. ENDIF
  123. GOTO 30
  124. ENDIF
  125. ENDIF
  126. *
  127. CALL ECROBJ('MCHAML',ICHCO)
  128. *
  129. 990 CONTINUE
  130. SEGSUP,TRAV
  131. 991 CONTINUE
  132. SEGSUP,ICPR
  133. *
  134. RETURN
  135. END
  136.  
  137.  
  138.  

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