Télécharger rccont.eso

Retour à la liste

Numérotation des lignes :

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

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