Télécharger rccon2.eso

Retour à la liste

Numérotation des lignes :

  1. C RCCON2 SOURCE CB215821 20/11/25 13:38:32 10792
  2. SUBROUTINE RCCON2(IBAS,KTRAV,KCPR,KCHAR,XTEMP,ICHCO,ITRES,IPOS,
  3. & ITLIA)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. * *
  8. * Recombine le chpoint ICHPT en contrainte. *
  9. * *
  10. * Param}tres: *
  11. * *
  12. * e IBAS table repr{sentant une base modale *
  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. * *
  19. * Auteur, date de cr{ation: *
  20. * *
  21. * Lionel VIVAN, le 26 avril 1990. *
  22. * *
  23. * REMARQUE :NORMALEMENT CHACUN DES MCHAML DE CONTRAINTE MODALE *
  24. * SONT SIMILAIRES.LES VERIFICATIONS DE CONFORMITE DE *
  25. * CHACUN DES MCHAMLs SERA DONC REDUIT AU MINIMUM. *
  26. * A SAVOIR LES SOUS ZONE PORTE BIEN LE MEME POINTEUR DE *
  27. * MAILLAGE ET LES NOMS DES COMPOSANTES QUE L ON MULTIPLIE *
  28. * SONT IDENTIQUES. *
  29. * *
  30. * Passage aux nouveaux chamelem par jm CAMPENON le 01/91 *
  31. * *
  32. *--------------------------------------------------------------------*
  33. -INC PPARAM
  34. -INC CCOPTIO
  35. -INC SMCOORD
  36. -INC SMCHAML
  37. SEGMENT ICPR(nbpts)
  38. SEGMENT ITRA1(NSOUS,4)
  39. SEGMENT TRAV(NPOIN)*D
  40. LOGICAL L0,L1
  41. CHARACTER*8 TYPRET,CHARRE
  42. *
  43. TRAV = KTRAV
  44. ICPR = KCPR
  45. *
  46. CALL ACCTAB(IBAS,'MOT',I0,X0,'MODES',L0,IP0,
  47. & 'TABLE',I1,X1,' ',L1,IBBB)
  48. *
  49. * initialisation du MCHAML
  50. *
  51. N1 = 1
  52. CALL ACCTAB(IBBB,'ENTIER',N1,X0,' ',L0,IP0,
  53. & 'TABLE',I1,X1,' ',L1,ITBMOD)
  54. TYPRET = ' '
  55. CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CONTRAINTE_MODALE',L0,IP0,
  56. & TYPRET,I1,X1,CHARRE,L1,IPHC1)
  57. IF (IPHC1.NE.0) THEN
  58. IF (TYPRET.EQ.'MCHAML ') GOTO 100
  59. ENDIF
  60. *
  61. MOTERR(1:8) = 'RCCON2 '
  62. INTERR(1) = N1
  63. CALL ERREUR(169)
  64. RETURN
  65. *
  66. 100 CONTINUE
  67. MCHEL1 = IPHC1
  68. SEGINI,MCHELM=MCHEL1
  69. ICHCO = MCHELM
  70. NSOUS= ICHAML(/1)
  71. SEGINI ITRA1
  72. DO 60 ISOUS=1,NSOUS
  73. ITRA1(ISOUS,1)=IMACHE(ISOUS)
  74. MCHAM1=ICHAML(ISOUS)
  75. SEGINI,MCHAML=MCHAM1
  76. ICHAML(ISOUS)=MCHAML
  77. ITRA1(ISOUS,2)=MCHAML
  78. 60 CONTINUE
  79. *
  80. * boucle sur le nombre de modes
  81. *
  82. IM = 0
  83. 40 CONTINUE
  84. IM = IM + 1
  85. TYPRET = ' '
  86. CALL ACCTAB(IBBB,'ENTIER',IM,X0,' ',L0,IP0,
  87. & TYPRET,I1,X1,CHARRE,L1,ITBMOD)
  88. IF (ITBMOD.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  89. TYPRET = ' '
  90. CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CONTRAINTE_MODALE',L0,IP0,
  91. & TYPRET,I1,X1,CHARRE,L1,IPHC1)
  92. C* IF (TYPRET.NE.'MCHAML ') THEN
  93. C* ERREUR ?
  94. C* ENDIF
  95. MCHEL1=IPHC1
  96. SEGACT MCHEL1
  97. DO 42 ISOUS=1,NSOUS
  98. IPMAIL=ITRA1(ISOUS,1)
  99. IF ( IPMAIL.NE.MCHEL1.IMACHE(ISOUS) ) THEN
  100. SEGDES MCHEL1
  101. CALL ERREUR(21)
  102. GOTO 9990
  103. ENDIF
  104. MCHAM1=MCHEL1.ICHAML(ISOUS)
  105. SEGACT MCHAM1
  106. MCHAML=ITRA1(ISOUS,2)
  107. NCOMP=IELVAL(/1)
  108. NCCHE=MCHAM1.NOMCHE(/2)
  109. DO 30 ICOMP=1,NCOMP
  110. CALL PLACE(MCHAM1.NOMCHE,NCCHE,IPLAC,
  111. & NOMCHE(ICOMP))
  112. IF (IPLAC.EQ.0) THEN
  113. SEGDES MCHAM1
  114. SEGDES MCHEL1
  115. CALL ERREUR(21)
  116. GOTO 9990
  117. ENDIF
  118. MELVA1=MCHAM1.IELVAL(IPLAC)
  119. SEGACT MELVA1
  120. N1PTEL = MELVA1.VELCHE(/1)
  121. N1EL = MELVA1.VELCHE(/2)
  122. ITRA1(ISOUS,3) = MAX(ITRA1(ISOUS,3),N1PTEL)
  123. ITRA1(ISOUS,4) = MAX(ITRA1(ISOUS,4),N1EL )
  124. SEGDES MELVA1
  125. 30 CONTINUE
  126. SEGDES MCHAM1
  127. 42 CONTINUE
  128. SEGDES MCHEL1
  129. GOTO 40
  130. ENDIF
  131. NBMODE = IM - 1
  132. *
  133. DO 50 ISOUS=1,NSOUS
  134. MCHAML=ITRA1(ISOUS,2)
  135. N1PTEL = ITRA1(ISOUS,3)
  136. N1EL = ITRA1(ISOUS,4)
  137. N2PTEL = 0
  138. N2EL = 0
  139. NCOMP=IELVAL(/1)
  140. DO 51 ICOMP=1,NCOMP
  141. SEGINI MELVAL
  142. IELVAL(ICOMP) = MELVAL
  143. 51 CONTINUE
  144. 50 CONTINUE
  145. *
  146. * boucle sur les contraintes modales
  147. *
  148. DO 300 IM = 1,NBMODE
  149. CALL ACCTAB(IBBB,'ENTIER',IM,X0,' ',L0,IP0,
  150. & 'TABLE',I1,X1,' ',L1,ITBMOD)
  151. CALL ACCTAB(ITBMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
  152. & 'POINT',I1,X1,' ',L1,IPTR)
  153. TYPRET = ' '
  154. CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CONTRAINTE_MODALE',L0,IP0,
  155. & TYPRET,I1,X1,CHARRE,L1,IPHC1)
  156. C* IF (TYPRET.NE.'MCHAML ') THEN
  157. C* ERREUR ?
  158. C* ENDIF
  159. IMODE = ICPR(IPTR)
  160. IF (IMODE.EQ.0) THEN
  161. *
  162. * on ne trouve pas la contrainte modale
  163. *
  164. MOTERR(1:8) = 'RCCON2'
  165. INTERR(1) = IM
  166. CALL ERREUR(169)
  167. CALL DTCHAM(ICHCO)
  168. GOTO 9990
  169. ENDIF
  170. XVAL = TRAV(IMODE)
  171. MCHEL1 = IPHC1
  172. SEGACT MCHEL1
  173. NSOU1 = MCHEL1.ICHAML(/1)
  174. DO 320 ISOU1 = 1,NSOU1
  175. MCHAML=ITRA1(ISOU1,2)
  176. MCHAM1=MCHEL1.ICHAML(ISOU1)
  177. SEGACT MCHAM1
  178. NCOMP=IELVAL(/1)
  179. NCCHE=MCHAM1.NOMCHE(/2)
  180. DO 342 ICOMP=1,NCOMP
  181. CALL PLACE(MCHAM1.NOMCHE,NCCHE,IPLAC,
  182. & NOMCHE(ICOMP))
  183. MELVA1=MCHAM1.IELVAL(IPLAC)
  184. SEGACT MELVA1
  185. MELVAL=IELVAL(ICOMP)
  186. DO 344 IGAU=1,VELCHE(/1)
  187. IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
  188. DO 344 IB=1,VELCHE(/2)
  189. IBMN=MIN(IB ,MELVA1.VELCHE(/2))
  190. VELCHE(IGAU,IB)=VELCHE(IGAU,IB)
  191. & +XVAL*MELVA1.VELCHE(IGMN,IBMN)
  192. 344 CONTINUE
  193. SEGDES MELVA1
  194. 342 CONTINUE
  195. SEGDES MCHAM1
  196. 320 CONTINUE
  197. SEGDES MCHEL1
  198. 300 CONTINUE
  199. DO 61 ISOUS=1,NSOUS
  200. MCHAML=ITRA1(ISOUS,2)
  201. NCOMP=IELVAL(/1)
  202. DO 62 ICOMP=1,NCOMP
  203. MELVAL=IELVAL(ICOMP)
  204. SEGDES MELVAL
  205. 62 CONTINUE
  206. SEGDES MCHAML
  207. 61 CONTINUE
  208. SEGDES MCHELM
  209. *
  210. * Prise en compte des pseudo-modes
  211. *
  212. IF (KCHAR.NE.0 .OR. ITLIA.NE.0) THEN
  213. TYPRET = ' '
  214. CALL ACCTAB(IBAS,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0,
  215. & TYPRET,I1,X1,CHARRE,L1,ITPS)
  216. IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  217. CALL PSRCD2('CONT',ITPS,IBBB,ICHCO,KCHAR,XTEMP,ITRES,IPOS,ITLIA)
  218. ELSE
  219. CALL ERREUR(429)
  220. ENDIF
  221. ENDIF
  222. RETURN
  223. *
  224. 9990 CONTINUE
  225. DO 71 ISOUS=1,NSOUS
  226. MCHAML=ITRA1(ISOUS,2)
  227. SEGSUP MCHAML
  228. 71 CONTINUE
  229. SEGSUP ITRA1
  230. C* SEGSUP MCHELM
  231.  
  232. RETURN
  233. END
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  

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