Télécharger dyne13.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNE13 SOURCE BP208322 14/09/15 21:16:29 8151
  2. SUBROUTINE DYNE13(ITBAS,ITKM,KPREF,KCPR,LMODYN)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. * *
  7. * Op{rateur DYNE : algorithme de Fu - de Vogelaere *
  8. * ________________________________________________ *
  9. * *
  10. * V{rification des objets TBAS, TKM, et notamment de *
  11. * leurs supports. Liste des points de r{f{rence. *
  12. * *
  13. * Param}tres: *
  14. * *
  15. * e ITBAS Table repr{sentant une base modale *
  16. * e ITKM Table contenant les matrices de raideur et de masse *
  17. * s KPREF Segment des points de r{f{rence *
  18. * s KCPR Segment des points *
  19. * *
  20. * Auteur, date de cr{ation: *
  21. * *
  22. * Denis ROBERT-MOUGIN, le 30 mai 1989. *
  23. * *
  24. *--------------------------------------------------------------------*
  25. -INC CCOPTIO
  26. -INC SMRIGID
  27. -INC SMCHPOI
  28. -INC SMELEME
  29. -INC SMCOORD
  30. -INC SMMODEL
  31. *
  32. SEGMENT,ICPR(XCOOR(/1)/(IDIM+1))
  33. SEGMENT,MPREF
  34. INTEGER IPOREF(NPREF)
  35. ENDSEGMENT
  36. *
  37. LOGICAL L0,L1,LMODYN
  38. CHARACTER*4 MO2
  39. CHARACTER*8 TYPRET,CHARRE
  40. CHARACTER*40 MONMOT
  41. *
  42. IK = 0
  43. IRIG = 0
  44. IMAS = 0
  45. IMESS = 0
  46. SEGINI,ICPR
  47. KCPR = ICPR
  48. LCPR = XCOOR(/1)/(IDIM+1)
  49. *
  50. * 1/ Cas oº la base modale est d{finie seule
  51. *
  52. IF (ITBAS.NE.0 .AND.ITKM.EQ.0.and.(.not.lmodyn)) THEN
  53. CALL ACCTAB(ITBAS,'MOT',IMODE,X0,'SOUSTYPE',L0,IP0,
  54. & 'MOT',I1,X1,MONMOT,L1,IP1)
  55. IF (IERR.NE.0) RETURN
  56. *
  57. * Cas oº la base est unique
  58. *
  59. IF (MONMOT(1:11).EQ.'BASE_MODALE') THEN
  60. *
  61. * On r{cup}re la base de modes
  62. *
  63. CALL ACCTAB(ITBAS,'MOT',IMODE,X0,'MODES',L0,IP0,
  64. & 'TABLE',I1,X1,' ',L1,IBAS)
  65. IF (IERR.NE.0) RETURN
  66. CALL DYNE25(IBAS,KCPR,IK)
  67. IF (IERR.NE.0) RETURN
  68. *
  69. * Cas oº on a un ensemble de bases
  70. *
  71. ELSE IF (MONMOT(1:17).EQ.'ENSEMBLE_DE_BASES') THEN
  72. *
  73. * On boucle sur le nombre de bases
  74. *
  75. IB = 0
  76. 10 CONTINUE
  77. IB = IB + 1
  78. TYPRET = ' '
  79. CALL ACCTAB(ITBAS,'ENTIER',IB,X0,' ',L0,IP0,
  80. & TYPRET,I1,X1,CHARRE,L1,ITTBAS)
  81. IF (IERR.NE.0) RETURN
  82. IF (ITTBAS.NE.0) THEN
  83. IF (TYPRET.EQ.'TABLE ') THEN
  84. CALL ACCTAB(ITTBAS,'MOT',I0,X0,'MODES',L0,IP0,
  85. & 'TABLE',I1,X1,' ',L1,IBAS)
  86. IF (IERR.NE.0) RETURN
  87. CALL DYNE25(IBAS,KCPR,IK)
  88. IF (IERR.NE.0) RETURN
  89. GOTO 10
  90. ELSE
  91. CALL ERREUR(491)
  92. RETURN
  93. ENDIF
  94. ENDIF
  95. *
  96. * Cas oº le SOUSTYPE est incorrect
  97. *
  98. ELSE
  99. CALL ERREUR(482)
  100. RETURN
  101. ENDIF
  102. *
  103. * 2/ Cas oº les matrices raideur et de masse sont d{finies seules
  104. *
  105. ELSE IF (ITBAS.EQ.0 .AND. ITKM.NE.0.and.(.not.lmodyn)) THEN
  106. TYPRET = ' '
  107. CALL ACCTAB(ITKM,'MOT',I0,X0,'RAIDEUR',L0,IP0,
  108. & TYPRET,I1,X1,CHARRE,L1,IRIG)
  109. IF (IERR.NE.0) RETURN
  110. IF (IRIG.NE.0 .AND. TYPRET.EQ.'RIGIDITE') THEN
  111. MRIGID = IRIG
  112. SEGACT,MRIGID
  113. NRIG = IRIGEL(/2)
  114. DO 20 I=1,NRIG
  115. MELEME = IRIGEL(1,I)
  116. SEGACT,MELEME
  117. NBEL = NUM(/2)
  118. NBNN = NUM(/1)
  119. DO 25 J=1,NBEL
  120. DO 26 K=1,NBNN
  121. KNOE = NUM(K,J)
  122. IF (ICPR(KNOE).EQ.0) THEN
  123. IK = IK + 1
  124. ICPR(KNOE) = IK
  125. IF (IIMPI.EQ.333) THEN
  126. WRITE(IOIMP,*)'DYNE13 : raideur ICPR(',KNOE,')=',ICPR(KNOE)
  127. ENDIF
  128. ENDIF
  129. 26 CONTINUE
  130. * end do
  131. 25 CONTINUE
  132. * end do
  133. SEGDES,MELEME
  134. 20 CONTINUE
  135. * end do
  136. SEGDES,MRIGID
  137. *
  138. * Cas oº le SOUSTYPE est incorrect
  139. *
  140. ELSE
  141. CALL ERREUR(483)
  142. RETURN
  143. ENDIF
  144. *
  145. TYPRET = ' '
  146. CALL ACCTAB(ITKM,'MOT',I0,X0,'MASSE',L0,IP0,
  147. & TYPRET,I1,X1,CHARRE,L1,IMAS)
  148. IF (IERR.NE.0) RETURN
  149. IF (IMAS.NE.0 .AND. TYPRET.EQ.'RIGIDITE') THEN
  150. MRIGID = IMAS
  151. SEGACT,MRIGID
  152. NMAS = IRIGEL(/2)
  153. DO 30 I=1,NMAS
  154. MELEME = IRIGEL(1,I)
  155. SEGACT,MELEME
  156. NBEL = NUM(/2)
  157. NBNN = NUM(/1)
  158. DO 35 J=1,NBEL
  159. DO 36 K=1,NBNN
  160. KNOE = NUM(K,J)
  161. IF (ICPR(KNOE).EQ.0) THEN
  162. IK = IK + 1
  163. ICPR(KNOE) = IK
  164. IF (IIMPI.EQ.333) THEN
  165. WRITE(IOIMP,*)'DYNE13 : masse ICPR(',KNOE,')=',ICPR(KNOE)
  166. ENDIF
  167. ENDIF
  168. 36 CONTINUE
  169. * end do
  170. 35 CONTINUE
  171. * end do
  172. SEGDES,MELEME
  173. 30 CONTINUE
  174. * end do
  175. SEGDES,MRIGID
  176. *
  177. * Cas oº le SOUSTYPE est incorrect
  178. *
  179. ELSE
  180. CALL ERREUR(484)
  181. RETURN
  182. ENDIF
  183. *
  184. * 3/ Cas oº la base modale est d{finie
  185. * et les matrices masse et rigidit{ sont d{finies
  186. *
  187. ELSE IF (ITBAS.NE.0 .AND. ITKM.NE.0.and.(.not.lmodyn)) THEN
  188. CALL ERREUR(478)
  189. RETURN
  190. *
  191. * table pasapas
  192. ELSE IF (LMODYN) THEN
  193. mmodel = itbas
  194. segact mmodel
  195. do im = 1,kmodel(/1)
  196. imodel = kmodel(im)
  197. segact imodel
  198. if (nefmod.ne.45) goto 45
  199. meleme = imamod
  200. segact meleme
  201. do ip = 1,num(/2)
  202. knoe = num(1,ip)
  203. IF (KNOE.NE.0) THEN
  204. IF (ICPR(KNOE).EQ.0) THEN
  205. IK = IK + 1
  206. ICPR(KNOE) = IK
  207. IF (IIMPI.EQ.333) THEN
  208. WRITE(IOIMP,*)'DYNE25 : basemo. ICPR(',KNOE,')=',ICPR(KNOE)
  209. ENDIF
  210. ENDIF
  211. ENDIF
  212. enddo
  213. segdes meleme
  214. 45 continue
  215. segdes imodel
  216. enddo
  217. segdes mmodel
  218. ENDIF
  219. *
  220. * 5/ Cr{ation du segment d{finissant les points supports:
  221. *
  222. NPREF = IK
  223. SEGINI,MPREF
  224. KPREF = MPREF
  225. IF (IIMPI.EQ.333) WRITE(IOIMP,*)'DYNE13 : KPREF=',KPREF,NPREF
  226. DO 100 I=1,LCPR
  227. IF (ICPR(I).NE.0) THEN
  228. IREF = ICPR(I)
  229. IPOREF(IREF) = I
  230. IF (IIMPI.EQ.333) THEN
  231. WRITE(IOIMP,*)'DYNE13 : IPOREF(',IREF,')=',IPOREF(IREF)
  232. ENDIF
  233. ENDIF
  234. 100 CONTINUE
  235. * end do
  236. *
  237. END
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  

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