Télécharger rcdep2.eso

Retour à la liste

Numérotation des lignes :

  1. C RCDEP2 SOURCE CHAT 05/01/13 02:45:55 5004
  2. SUBROUTINE RCDEP2(IBAS,KTRAV,KCPR,KCHAR,XTEMP,ICHDE,ITRES,IPOS,
  3. & ITLIA,ITYP)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. * *
  8. * Recombine le chpoint ICHPT en déplacement ou en réaction. *
  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. * e ITYP = 0 , on recombine les déplacements nature diffuse * *
  19. * = 1 , on recombine les vitesses *
  20. * =-1 , on recombine les accélérations *
  21. * = 2 , on recombine les réactions. nature discrete * *
  22. * - RIGIDE Vrai si l'on a un corps rigide,faux sinon *
  23. * *
  24. * Auteur, date de création: *
  25. * *
  26. * Lionel VIVAN, le 26 avril 1990. *
  27. * *
  28. *--------------------------------------------------------------------*
  29. -INC CCOPTIO
  30. -INC SMCOORD
  31. -INC SMCHPOI
  32. -INC SMELEME
  33. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  34. SEGMENT TRAV(NPOIN)*D
  35. LOGICAL L0,L1,RIGIDE
  36. CHARACTER*8 TYPRET,MORIGI,CMOT,CHARRE
  37. REAL*8 XAXROT(3),XROTA(2,6)
  38. *
  39.  
  40. TRAV = KTRAV
  41. ICPR = KCPR
  42. RIGIDE =.FALSE.
  43. *
  44. CALL ACCTAB(IBAS,'MOT',I0,X0,'MODES',L0,IP0,
  45. & 'TABLE',I1,X1,' ',L1,IBBB)
  46. *
  47. * initialisation du CHPOINT
  48. *
  49. N1 = 1
  50. CALL ACCTAB(IBBB,'ENTIER',N1,X0,' ',L0,IP0,
  51. & 'TABLE',I1,X1,' ',L1,ITBMOD)
  52. TYPRET = ' '
  53. IF (ITYP.EQ.0.OR.ITYP.EQ.1.OR.ITYP.EQ.-1) THEN
  54. CALL ACCTAB(ITBMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  55. & TYPRET,I1,X1,CHARRE,L1,ICHD1)
  56. ELSE IF (ITYP.EQ.2) THEN
  57. CALL ACCTAB(ITBMOD,'MOT',I0,X0,'REACTION_MODALE',L0,IP0,
  58. & TYPRET,I1,X1,CHARRE,L1,ICHD1)
  59. ENDIF
  60. IF (ICHD1.EQ.0 .OR. TYPRET.NE.'CHPOINT ') THEN
  61. MOTERR(1:8) = 'RCDEP2 '
  62. INTERR(1) = N1
  63. CALL ERREUR(169)
  64. RETURN
  65. ENDIF
  66. MCHPO1 = ICHD1
  67. SEGACT MCHPO1
  68. NSOUPO = MCHPO1.IPCHP(/1)
  69. NAT=MAX(MCHPO1.JATTRI(/1),1)
  70. SEGINI MCHPOI
  71. ICHDE = MCHPOI
  72. IFOPOI = MCHPO1.IFOPOI
  73. MTYPOI = MCHPO1.MTYPOI
  74. MOCHDE = ' CHPOINT CREE PAR RCDEP2 '
  75. IF ( ITYP .EQ. 0 .OR.ITYP.EQ.1.OR.ITYP.EQ.-1) THEN
  76. JATTRI(1) = 1
  77. ELSE IF ( ITYP .EQ. 2 ) THEN
  78. JATTRI(1) = 2
  79. ENDIF
  80. DO 10 ISOU = 1,NSOUPO
  81. MSOUP1 = MCHPO1.IPCHP(ISOU)
  82. SEGACT MSOUP1
  83. NC = MSOUP1.NOCOMP(/2)
  84. SEGINI MSOUPO
  85. IPCHP(ISOU) = MSOUPO
  86. DO 12 IC = 1,NC
  87. NOCOMP(IC) = MSOUP1.NOCOMP(IC)
  88. NOHARM(IC) = MSOUP1.NOHARM(IC)
  89. 12 CONTINUE
  90. IGEOC = MSOUP1.IGEOC
  91. MELEME = IGEOC
  92. SEGACT MELEME
  93. N = NUM(/2)
  94. SEGDES MELEME,MSOUP1
  95. SEGINI MPOVAL
  96. IPOVAL = MPOVAL
  97. SEGDES MPOVAL
  98. SEGDES MSOUPO
  99. 10 CONTINUE
  100. SEGDES MCHPO1
  101. *
  102. * boucle sur le nombre de modes
  103. *
  104. IM = 0
  105. 20 CONTINUE
  106. IM = IM + 1
  107. TYPRET = ' '
  108. CALL ACCTAB(IBBB,'ENTIER',IM,X0,' ',L0,IP0,
  109. & TYPRET,I1,X1,CHARRE,L1,ITBMOD)
  110. IF (ITBMOD.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  111. CALL ACCTAB(ITBMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
  112. & 'POINT',I1,X1,' ',L1,IPTR)
  113. IF (ITYP.EQ.0.OR.ITYP.EQ.1.OR.ITYP.EQ.-1) THEN
  114. CALL ACCTAB(ITBMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  115. & 'CHPOINT',I1,X1,' ',L1,ICHDI)
  116. rigide = .false.
  117. MORIGI = ' '
  118. CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CORPS_RIGIDE',L0,IP0,
  119. & MORIGI,I1,X1,CMOT,L1,IP1)
  120. IF (IERR.NE.0) RETURN
  121. IF (MORIGI.EQ.'MOT') THEN
  122. IF (CMOT(1:4).EQ.'VRAI') THEN
  123. RIGIDE =.TRUE.
  124. ENDIF
  125. ENDIF
  126. ELSE IF (ITYP.EQ.2) THEN
  127. CALL ACCTAB(ITBMOD,'MOT',I0,X0,'REACTION_MODALE',L0,IP0,
  128. & 'CHPOINT',I1,X1,' ',L1,ICHDI)
  129. ENDIF
  130. IMODE = ICPR(IPTR)
  131. IF (IMODE.EQ.0) THEN
  132. *
  133. * on ne trouve pas la déformée modale
  134. *
  135. MOTERR(1:8) = 'RCDEP2'
  136. INTERR(1) = IM
  137. CALL ERREUR(169)
  138. RETURN
  139. ENDIF
  140. XVAL = TRAV(IMODE)
  141. MCHPO1 = ICHDI
  142. SEGACT MCHPO1
  143. DO 22 ISOU = 1,NSOUPO
  144. MSOUP1 = MCHPO1.IPCHP(ISOU)
  145. MSOUPO = IPCHP(ISOU)
  146. SEGACT MSOUP1,MSOUPO
  147. MPOVA1 = MSOUP1.IPOVAL
  148. MPOVAL = IPOVAL
  149. SEGDES MSOUP1
  150. SEGACT MPOVA1,MPOVAL*MOD
  151. N = MPOVA1.VPOCHA(/1)
  152. NC = MPOVA1.VPOCHA(/2)
  153. DO 24 IC = 1,NC
  154. DO 26 IN = 1,N
  155. VPOCHA(IN,IC) = VPOCHA(IN,IC)
  156. & + ( XVAL * MPOVA1.VPOCHA(IN,IC) )
  157. 26 CONTINUE
  158. 24 CONTINUE
  159. SEGDES MPOVA1,MPOVAL
  160. SEGDES MSOUP1,MSOUPO
  161. 22 CONTINUE
  162. SEGDES MCHPO1
  163. *
  164. * Prise en compte de la rotation des corps rigide
  165. *
  166. IF ((ITYP.EQ.0.OR.ITYP.EQ.1.OR.ITYP.EQ.-1).AND.RIGIDE) THEN
  167. CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CENTRE_DE_GRAVITE',L0,IP0,
  168. & 'POINT',I1,X1,' ',L1,ICDG)
  169. IF (IERR.NE.0) RETURN
  170. IF (ITYP.EQ.1.OR.ITYP.EQ.-1) THEN
  171. * On récupère la valeur de la rotation
  172. CALL RECANG(ITRES,IPOS,IPTR,XANGLE)
  173. *
  174. IF (ITYP.EQ.-1) THEN
  175. * On récupère la valeur de la vitesse angulaire
  176. CALL RECVIT(ITRES,IPOS,IPTR,XVIT)
  177. ENDIF
  178. ENDIF
  179. MERR =0
  180. MCHPO1=ICHDI
  181. SEGACT MCHPO1
  182. IF (IDIM.EQ.3) THEN
  183. IDIMB=6
  184. ELSE
  185. IDIMB=3
  186. ENDIF
  187. DO 30 ISOU =1,NSOUPO
  188. MSOUPO = IPCHP(ISOU)
  189. MSOUP1 = MCHPO1.IPCHP(ISOU)
  190. SEGACT MSOUPO,MSOUP1
  191. MELEME = IGEOC
  192. SEGACT MELEME
  193. MPOVAL = IPOVAL
  194. MPOVA1 = MSOUP1.IPOVAL
  195. SEGACT MPOVAL*MOD,MPOVA1
  196. N = VPOCHA(/1)
  197. DO 32 IN=1,N
  198. IPOINT = NUM(1,IN)
  199. DO 33 ID=(IDIM+1),IDIMB
  200. * On récupère l'axe de rotation
  201. XAXROT(ID-IDIM) = MPOVA1.VPOCHA(IN,ID)
  202. 33 CONTINUE
  203. * En 3D on le norme, on vérifie qu'il n'est pas nul
  204. CALL DYNE41(XAXROT,MERR,IDIM)
  205. * Calcul des fausses déformées modales de rotation
  206. CALL DYNE42(XROTA,XAXROT,IPOINT,ICDG,IDIMB,MERR)
  207. IF (ITYP.EQ.0) THEN
  208. * Recombinaison de déplacements
  209. DO 34 ID=1,IDIM
  210. VPOCHA(IN,ID)=VPOCHA(IN,ID)+ (XROTA(1,ID)*
  211. &(COS(XVAL)-1) + XROTA(2,ID)*SIN(XVAL))
  212. 34 CONTINUE
  213. ELSE
  214. * Recombinaison de vitesses ou d accélérations
  215. DO 35 ID=1,IDIM
  216. VPOCHA(IN,ID)=VPOCHA(IN,ID)+XVAL*(COS(XANGLE)*
  217. &XROTA(2,ID)-SIN(XANGLE)*XROTA(1,ID))
  218. 35 CONTINUE
  219. IF (ITYP.EQ.-1) THEN
  220. * Recombinaison d accélérations
  221. DO 36 ID=1,IDIM
  222. VPOCHA(IN,ID)=VPOCHA(IN,ID)-XVIT*XVIT*
  223. &(COS(XANGLE)*XROTA(1,ID)+SIN(XANGLE)*XROTA(2,ID))
  224. 36 CONTINUE
  225. ENDIF
  226. ENDIF
  227. 32 CONTINUE
  228. SEGDES MPOVAL,MSOUPO,MELEME,MPOVA1,MSOUP1
  229. 30 CONTINUE
  230. SEGDES MCHPO1
  231. ENDIF
  232. GOTO 20
  233. ENDIF
  234. SEGDES MCHPOI
  235. *
  236. * Prise en compte des pseudo-modes
  237. *
  238. IF (KCHAR.NE.0 .OR. ITLIA.NE.0) THEN
  239. TYPRET = ' '
  240. CALL ACCTAB(IBAS,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0,
  241. & TYPRET,I1,X1,CHARRE,L1,ITPS)
  242. IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  243. IF (ITYP.EQ.0.OR.ITYP.EQ.1.OR.ITYP.EQ.-1) THEN
  244. CALL PSRCD2('DEPL',ITPS,IBBB,ICHDE,KCHAR,XTEMP,ITRES,IPOS,ITLIA)
  245. ELSE IF (ITYP.EQ.2) THEN
  246. CALL PSRCD2('REAC',ITPS,IBBB,ICHDE,KCHAR,XTEMP,ITRES,IPOS,ITLIA)
  247. ENDIF
  248. ELSE
  249. CALL ERREUR(429)
  250. ENDIF
  251. ENDIF
  252. *
  253. END
  254.  
  255.  
  256.  
  257.  
  258.  

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