Télécharger rccon2.eso

Retour à la liste

Numérotation des lignes :

  1. C RCCON2 SOURCE FANDEUR 14/03/25 21:15:29 7993
  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 CCOPTIO
  34. -INC SMCOORD
  35. -INC SMCHAML
  36. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  37. SEGMENT ITRA1(NSOUS,4)
  38. SEGMENT TRAV(NPOIN)*D
  39. LOGICAL L0,L1
  40. CHARACTER*8 TYPRET,CHARRE
  41. *
  42. TRAV = KTRAV
  43. ICPR = KCPR
  44. *
  45. CALL ACCTAB(IBAS,'MOT',I0,X0,'MODES',L0,IP0,
  46. & 'TABLE',I1,X1,' ',L1,IBBB)
  47. *
  48. * initialisation du MCHAML
  49. *
  50. N1 = 1
  51. CALL ACCTAB(IBBB,'ENTIER',N1,X0,' ',L0,IP0,
  52. & 'TABLE',I1,X1,' ',L1,ITBMOD)
  53. TYPRET = ' '
  54. CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CONTRAINTE_MODALE',L0,IP0,
  55. & TYPRET,I1,X1,CHARRE,L1,IPHC1)
  56. IF (IPHC1.NE.0) THEN
  57. IF (TYPRET.EQ.'MCHAML ') GOTO 100
  58. ENDIF
  59. *
  60. MOTERR(1:8) = 'RCCON2 '
  61. INTERR(1) = N1
  62. CALL ERREUR(169)
  63. RETURN
  64. *
  65. 100 CONTINUE
  66. MCHEL1 = IPHC1
  67. SEGINI,MCHELM=MCHEL1
  68. ICHCO = MCHELM
  69. NSOUS= ICHAML(/1)
  70. SEGINI ITRA1
  71. DO 60 ISOUS=1,NSOUS
  72. ITRA1(ISOUS,1)=IMACHE(ISOUS)
  73. MCHAM1=ICHAML(ISOUS)
  74. SEGINI,MCHAML=MCHAM1
  75. ICHAML(ISOUS)=MCHAML
  76. ITRA1(ISOUS,2)=MCHAML
  77. 60 CONTINUE
  78. *
  79. * boucle sur le nombre de modes
  80. *
  81. IM = 0
  82. 40 CONTINUE
  83. IM = IM + 1
  84. TYPRET = ' '
  85. CALL ACCTAB(IBBB,'ENTIER',IM,X0,' ',L0,IP0,
  86. & TYPRET,I1,X1,CHARRE,L1,ITBMOD)
  87. IF (ITBMOD.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  88. TYPRET = ' '
  89. CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CONTRAINTE_MODALE',L0,IP0,
  90. & TYPRET,I1,X1,CHARRE,L1,IPHC1)
  91. C* IF (TYPRET.NE.'MCHAML ') THEN
  92. C* ERREUR ?
  93. C* ENDIF
  94. MCHEL1=IPHC1
  95. SEGACT MCHEL1
  96. DO 42 ISOUS=1,NSOUS
  97. IPMAIL=ITRA1(ISOUS,1)
  98. IF ( IPMAIL.NE.MCHEL1.IMACHE(ISOUS) ) THEN
  99. SEGDES MCHEL1
  100. CALL ERREUR(21)
  101. GOTO 9990
  102. ENDIF
  103. MCHAM1=MCHEL1.ICHAML(ISOUS)
  104. SEGACT MCHAM1
  105. MCHAML=ITRA1(ISOUS,2)
  106. NCOMP=IELVAL(/1)
  107. DO 30 ICOMP=1,NCOMP
  108. CALL PLACE ( MCHAM1.NOMCHE,MCHAM1.NOMCHE(/1),IPLAC,
  109. & NOMCHE(ICOMP) )
  110. IF (IPLAC.EQ.0) THEN
  111. SEGDES MCHAM1
  112. SEGDES MCHEL1
  113. CALL ERREUR(21)
  114. GOTO 9990
  115. ENDIF
  116. MELVA1=MCHAM1.IELVAL(IPLAC)
  117. SEGACT MELVA1
  118. N1PTEL = MELVA1.VELCHE(/1)
  119. N1EL = MELVA1.VELCHE(/2)
  120. ITRA1(ISOUS,3) = MAX(ITRA1(ISOUS,3),N1PTEL)
  121. ITRA1(ISOUS,4) = MAX(ITRA1(ISOUS,4),N1EL )
  122. SEGDES MELVA1
  123. 30 CONTINUE
  124. SEGDES MCHAM1
  125. 42 CONTINUE
  126. SEGDES MCHEL1
  127. GOTO 40
  128. ENDIF
  129. NBMODE = IM - 1
  130. *
  131. DO 50 ISOUS=1,NSOUS
  132. MCHAML=ITRA1(ISOUS,2)
  133. N1PTEL = ITRA1(ISOUS,3)
  134. N1EL = ITRA1(ISOUS,4)
  135. N2PTEL = 0
  136. N2EL = 0
  137. NCOMP=IELVAL(/1)
  138. DO 51 ICOMP=1,NCOMP
  139. SEGINI MELVAL
  140. IELVAL(ICOMP) = MELVAL
  141. 51 CONTINUE
  142. 50 CONTINUE
  143. *
  144. * boucle sur les contraintes modales
  145. *
  146. DO 300 IM = 1,NBMODE
  147. CALL ACCTAB(IBBB,'ENTIER',IM,X0,' ',L0,IP0,
  148. & 'TABLE',I1,X1,' ',L1,ITBMOD)
  149. CALL ACCTAB(ITBMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
  150. & 'POINT',I1,X1,' ',L1,IPTR)
  151. TYPRET = ' '
  152. CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CONTRAINTE_MODALE',L0,IP0,
  153. & TYPRET,I1,X1,CHARRE,L1,IPHC1)
  154. C* IF (TYPRET.NE.'MCHAML ') THEN
  155. C* ERREUR ?
  156. C* ENDIF
  157. IMODE = ICPR(IPTR)
  158. IF (IMODE.EQ.0) THEN
  159. *
  160. * on ne trouve pas la contrainte modale
  161. *
  162. MOTERR(1:8) = 'RCCON2'
  163. INTERR(1) = IM
  164. CALL ERREUR(169)
  165. CALL DTCHAM(ICHCO)
  166. GOTO 9990
  167. ENDIF
  168. XVAL = TRAV(IMODE)
  169. MCHEL1 = IPHC1
  170. SEGACT MCHEL1
  171. NSOU1 = MCHEL1.ICHAML(/1)
  172. DO 320 ISOU1 = 1,NSOU1
  173. MCHAML=ITRA1(ISOU1,2)
  174. MCHAM1=MCHEL1.ICHAML(ISOU1)
  175. SEGACT MCHAM1
  176. NCOMP=IELVAL(/1)
  177. DO 342 ICOMP=1,NCOMP
  178. CALL PLACE ( MCHAM1.NOMCHE,MCHAM1.NOMCHE(/1),IPLAC,
  179. & NOMCHE(ICOMP) )
  180. MELVA1=MCHAM1.IELVAL(IPLAC)
  181. SEGACT MELVA1
  182. MELVAL=IELVAL(ICOMP)
  183. DO 344 IGAU=1,VELCHE(/1)
  184. IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
  185. DO 344 IB=1,VELCHE(/2)
  186. IBMN=MIN(IB ,MELVA1.VELCHE(/2))
  187. VELCHE(IGAU,IB)=VELCHE(IGAU,IB)
  188. & +XVAL*MELVA1.VELCHE(IGMN,IBMN)
  189. 344 CONTINUE
  190. SEGDES MELVA1
  191. 342 CONTINUE
  192. SEGDES MCHAM1
  193. 320 CONTINUE
  194. SEGDES MCHEL1
  195. 300 CONTINUE
  196. DO 61 ISOUS=1,NSOUS
  197. MCHAML=ITRA1(ISOUS,2)
  198. NCOMP=IELVAL(/1)
  199. DO 62 ICOMP=1,NCOMP
  200. MELVAL=IELVAL(ICOMP)
  201. SEGDES MELVAL
  202. 62 CONTINUE
  203. SEGDES MCHAML
  204. 61 CONTINUE
  205. SEGDES MCHELM
  206. *
  207. * Prise en compte des pseudo-modes
  208. *
  209. IF (KCHAR.NE.0 .OR. ITLIA.NE.0) THEN
  210. TYPRET = ' '
  211. CALL ACCTAB(IBAS,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0,
  212. & TYPRET,I1,X1,CHARRE,L1,ITPS)
  213. IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  214. CALL PSRCD2('CONT',ITPS,IBBB,ICHCO,KCHAR,XTEMP,ITRES,IPOS,ITLIA)
  215. ELSE
  216. CALL ERREUR(429)
  217. ENDIF
  218. ENDIF
  219. RETURN
  220. *
  221. 9990 CONTINUE
  222. DO 71 ISOUS=1,NSOUS
  223. MCHAML=ITRA1(ISOUS,2)
  224. SEGSUP MCHAML
  225. 71 CONTINUE
  226. SEGSUP ITRA1
  227. C* SEGSUP MCHELM
  228.  
  229. RETURN
  230. END
  231.  
  232.  
  233.  

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