Télécharger rccon2.eso

Retour à la liste

Numérotation des lignes :

  1. C RCCON2 SOURCE PV 20/03/30 21:23:25 10567
  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. DO 30 ICOMP=1,NCOMP
  109. CALL PLACE ( MCHAM1.NOMCHE,MCHAM1.NOMCHE(/1),IPLAC,
  110. & NOMCHE(ICOMP) )
  111. IF (IPLAC.EQ.0) THEN
  112. SEGDES MCHAM1
  113. SEGDES MCHEL1
  114. CALL ERREUR(21)
  115. GOTO 9990
  116. ENDIF
  117. MELVA1=MCHAM1.IELVAL(IPLAC)
  118. SEGACT MELVA1
  119. N1PTEL = MELVA1.VELCHE(/1)
  120. N1EL = MELVA1.VELCHE(/2)
  121. ITRA1(ISOUS,3) = MAX(ITRA1(ISOUS,3),N1PTEL)
  122. ITRA1(ISOUS,4) = MAX(ITRA1(ISOUS,4),N1EL )
  123. SEGDES MELVA1
  124. 30 CONTINUE
  125. SEGDES MCHAM1
  126. 42 CONTINUE
  127. SEGDES MCHEL1
  128. GOTO 40
  129. ENDIF
  130. NBMODE = IM - 1
  131. *
  132. DO 50 ISOUS=1,NSOUS
  133. MCHAML=ITRA1(ISOUS,2)
  134. N1PTEL = ITRA1(ISOUS,3)
  135. N1EL = ITRA1(ISOUS,4)
  136. N2PTEL = 0
  137. N2EL = 0
  138. NCOMP=IELVAL(/1)
  139. DO 51 ICOMP=1,NCOMP
  140. SEGINI MELVAL
  141. IELVAL(ICOMP) = MELVAL
  142. 51 CONTINUE
  143. 50 CONTINUE
  144. *
  145. * boucle sur les contraintes modales
  146. *
  147. DO 300 IM = 1,NBMODE
  148. CALL ACCTAB(IBBB,'ENTIER',IM,X0,' ',L0,IP0,
  149. & 'TABLE',I1,X1,' ',L1,ITBMOD)
  150. CALL ACCTAB(ITBMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
  151. & 'POINT',I1,X1,' ',L1,IPTR)
  152. TYPRET = ' '
  153. CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CONTRAINTE_MODALE',L0,IP0,
  154. & TYPRET,I1,X1,CHARRE,L1,IPHC1)
  155. C* IF (TYPRET.NE.'MCHAML ') THEN
  156. C* ERREUR ?
  157. C* ENDIF
  158. IMODE = ICPR(IPTR)
  159. IF (IMODE.EQ.0) THEN
  160. *
  161. * on ne trouve pas la contrainte modale
  162. *
  163. MOTERR(1:8) = 'RCCON2'
  164. INTERR(1) = IM
  165. CALL ERREUR(169)
  166. CALL DTCHAM(ICHCO)
  167. GOTO 9990
  168. ENDIF
  169. XVAL = TRAV(IMODE)
  170. MCHEL1 = IPHC1
  171. SEGACT MCHEL1
  172. NSOU1 = MCHEL1.ICHAML(/1)
  173. DO 320 ISOU1 = 1,NSOU1
  174. MCHAML=ITRA1(ISOU1,2)
  175. MCHAM1=MCHEL1.ICHAML(ISOU1)
  176. SEGACT MCHAM1
  177. NCOMP=IELVAL(/1)
  178. DO 342 ICOMP=1,NCOMP
  179. CALL PLACE ( MCHAM1.NOMCHE,MCHAM1.NOMCHE(/1),IPLAC,
  180. & NOMCHE(ICOMP) )
  181. MELVA1=MCHAM1.IELVAL(IPLAC)
  182. SEGACT MELVA1
  183. MELVAL=IELVAL(ICOMP)
  184. DO 344 IGAU=1,VELCHE(/1)
  185. IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
  186. DO 344 IB=1,VELCHE(/2)
  187. IBMN=MIN(IB ,MELVA1.VELCHE(/2))
  188. VELCHE(IGAU,IB)=VELCHE(IGAU,IB)
  189. & +XVAL*MELVA1.VELCHE(IGMN,IBMN)
  190. 344 CONTINUE
  191. SEGDES MELVA1
  192. 342 CONTINUE
  193. SEGDES MCHAM1
  194. 320 CONTINUE
  195. SEGDES MCHEL1
  196. 300 CONTINUE
  197. DO 61 ISOUS=1,NSOUS
  198. MCHAML=ITRA1(ISOUS,2)
  199. NCOMP=IELVAL(/1)
  200. DO 62 ICOMP=1,NCOMP
  201. MELVAL=IELVAL(ICOMP)
  202. SEGDES MELVAL
  203. 62 CONTINUE
  204. SEGDES MCHAML
  205. 61 CONTINUE
  206. SEGDES MCHELM
  207. *
  208. * Prise en compte des pseudo-modes
  209. *
  210. IF (KCHAR.NE.0 .OR. ITLIA.NE.0) THEN
  211. TYPRET = ' '
  212. CALL ACCTAB(IBAS,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0,
  213. & TYPRET,I1,X1,CHARRE,L1,ITPS)
  214. IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  215. CALL PSRCD2('CONT',ITPS,IBBB,ICHCO,KCHAR,XTEMP,ITRES,IPOS,ITLIA)
  216. ELSE
  217. CALL ERREUR(429)
  218. ENDIF
  219. ENDIF
  220. RETURN
  221. *
  222. 9990 CONTINUE
  223. DO 71 ISOUS=1,NSOUS
  224. MCHAML=ITRA1(ISOUS,2)
  225. SEGSUP MCHAML
  226. 71 CONTINUE
  227. SEGSUP ITRA1
  228. C* SEGSUP MCHELM
  229.  
  230. RETURN
  231. END
  232.  
  233.  
  234.  
  235.  

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