Télécharger rcdepl.eso

Retour à la liste

Numérotation des lignes :

  1. C RCDEPL SOURCE BP208322 17/07/25 21:15:16 9518
  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 deplacements modaux au temps XTEMP *
  8. * *
  9. * Parametres: *
  10. * *
  11. * e ITBAS table representant une base modale *
  12. * e ICHPT chpoint modal a recombiner (si >0) *
  13. * table de listreel modal a recombiner (si <0) *
  14. * e KCHAR chargement de la structure *
  15. * e XTEMP temps de recombinaison *
  16. * e ITRES table resultat issue de l'operateur DYNE *
  17. * e IPOS position de XTEMP dans le listreel des temps *
  18. * e ITLIA table des liaisons *
  19. * e ITYP = 0 , on recombine les deplacements *
  20. * = 2 , on recombine les reactions *
  21. * *
  22. * Auteur, date de creation: *
  23. * *
  24. * Lionel VIVAN, le 18 avril 1990. *
  25. * *
  26. *--------------------------------------------------------------------*
  27. -INC CCOPTIO
  28. -INC SMCHPOI
  29. -INC SMELEME
  30. -INC SMCOORD
  31. -INC SMTABLE
  32. -INC SMLREEL
  33. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  34. SEGMENT TRAV(NPOIN)*D
  35. LOGICAL L0,L1
  36. CHARACTER*8 TYPRET,CHARRE
  37. CHARACTER*40 TYPBAS
  38.  
  39. *-----------------------------------------------------------------------
  40. * on met les contributions modales ICHPT dans ICPR et TRAV
  41. *-----------------------------------------------------------------------
  42.  
  43. IF (ICHPT.GT.0) GOTO 100
  44.  
  45. * --- Cas des sortie DYNE de type table de LISTREEL ---
  46. MTABLE=-1*ICHPT
  47. SEGACT,MTABLE
  48. SEGINI ICPR
  49. KCPR = ICPR
  50. IKI = 0
  51. DO 1 I=1,MLOTAB
  52. IF(MTABTI(I).NE.'POINT ') GOTO 1
  53. IF(MTABTV(I).NE.'LISTREEL') GOTO 1
  54. IKI=IKI+1
  55. ICPR(MTABII(I))=IKI
  56. 1 CONTINUE
  57. NPOIN = IKI
  58. SEGINI TRAV
  59. KTRAV = TRAV
  60. IKI = 0
  61. DO 2 I=1,MLOTAB
  62. IF(MTABTI(I).NE.'POINT ') GOTO 2
  63. IF(MTABTV(I).NE.'LISTREEL') GOTO 2
  64. IKI=IKI+1
  65. MLREEL=MTABIV(I)
  66. SEGACT,MLREEL
  67. TRAV(IKI)=PROG(IPOS)
  68. SEGDES,MLREEL
  69. 2 CONTINUE
  70.  
  71. GOTO 200
  72.  
  73.  
  74. 100 CONTINUE
  75. * --- Cas des sortie DYNE de type CHPOINT ---
  76.  
  77. MCHPOI = ICHPT
  78. IF (MCHPOI.EQ.0) THEN
  79. * le CHPOINT des contributions modales est nul
  80. MOTERR(1:8) = 'RCDEPL'
  81. CALL ERREUR(170)
  82. RETURN
  83. ENDIF
  84. SEGINI ICPR
  85. KCPR = ICPR
  86. SEGACT MCHPOI
  87. NSOU = IPCHP(/1)
  88. IKI = 0
  89. DO 10 ISOU = 1,NSOU
  90. MSOUPO = IPCHP(ISOU)
  91. SEGACT MSOUPO
  92. * on cherche un CHPOINT qui contient des contributions modales
  93. IF (NOCOMP(/2).NE.1) THEN
  94. CALL ERREUR(188)
  95. SEGDES MSOUPO
  96. SEGDES MCHPOI
  97. SEGSUP ICPR
  98. RETURN
  99. ENDIF
  100. IF (NOCOMP(1).NE.'ALFA') THEN
  101. CALL ERREUR(188)
  102. SEGDES MSOUPO
  103. SEGDES MCHPOI
  104. SEGSUP ICPR
  105. RETURN
  106. ENDIF
  107. MELEME = IGEOC
  108. SEGACT MELEME
  109. N2 = NUM(/2)
  110. DO 12 I = 1,N2
  111. IKI = IKI + 1
  112. ICPR(NUM(1,I)) = IKI
  113. 12 CONTINUE
  114. SEGDES MELEME,MSOUPO
  115. 10 CONTINUE
  116. NPOIN = IKI
  117. SEGINI TRAV
  118. KTRAV = TRAV
  119. IKI = 0
  120. DO 20 ISOU = 1,NSOU
  121. MSOUPO = IPCHP(ISOU)
  122. SEGACT MSOUPO
  123. MPOVAL = IPOVAL
  124. SEGACT MPOVAL
  125. N2 = VPOCHA(/1)
  126. DO 22 I = 1,N2
  127. IKI = IKI + 1
  128. TRAV(IKI) = VPOCHA(I,1)
  129. 22 CONTINUE
  130. SEGDES MPOVAL,MSOUPO
  131. 20 CONTINUE
  132. SEGDES MCHPOI
  133.  
  134. 200 CONTINUE
  135.  
  136. *-----------------------------------------------------------------------
  137. * recup de la base modale
  138. *-----------------------------------------------------------------------
  139.  
  140. CALL ACCTAB(ITBAS,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  141. & 'MOT',I1,X1,TYPBAS,L1,IP1)
  142. *
  143. * Cas ou la base est unique
  144. *
  145. IF (TYPBAS(1:11).EQ.'BASE_MODALE') THEN
  146. CALL RCDEP2(ITBAS,KTRAV,KCPR,KCHAR,XTEMP,ICHDE,ITRES,IPOS,
  147. & ITLIA,ITYP)
  148. IF (IERR.NE.0) THEN
  149. SEGSUP TRAV,ICPR
  150. RETURN
  151. ENDIF
  152. *
  153. * Cas ou on a un ensemble de bases
  154. *
  155. ELSE IF (TYPBAS(1:17).EQ.'ENSEMBLE_DE_BASES') THEN
  156. *
  157. * On boucle sur le nombre de bases
  158. *
  159. IB = 0
  160. 30 CONTINUE
  161. TYPRET = ' '
  162. IB = IB + 1
  163. CALL ACCTAB(ITBAS,'ENTIER',IB,X0,' ',L0,IP0,
  164. & TYPRET,I1,X1,CHARRE,L1,ITTBAS)
  165. IF (ITTBAS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  166. CALL RCDEP2(ITTBAS,KTRAV,KCPR,KCHAR,XTEMP,IRET,ITRES,IPOS,
  167. & ITLIA,ITYP)
  168. IF (IERR.NE.0) THEN
  169. SEGSUP TRAV,ICPR
  170. RETURN
  171. ENDIF
  172. IF (IB.EQ.1) THEN
  173. ICHDE = IRET
  174. ELSE
  175. N1 = 1
  176. CALL ADCHPO(ICHDE,IRET,ICHDE,1D0,1D0)
  177. ENDIF
  178. GOTO 30
  179. ENDIF
  180. ENDIF
  181. *
  182. SEGSUP TRAV,ICPR
  183. *
  184. CALL ECROBJ('CHPOINT ',ICHDE)
  185. *
  186. END
  187.  
  188.  
  189.  
  190.  

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