Télécharger rcdep2.eso

Retour à la liste

Numérotation des lignes :

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

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