Télécharger rcdepl.eso

Retour à la liste

Numérotation des lignes :

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

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