Télécharger rcdepl.eso

Retour à la liste

Numérotation des lignes :

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

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