Télécharger rccont.eso

Retour à la liste

Numérotation des lignes :

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

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