Télécharger dyne13.eso

Retour à la liste

Numérotation des lignes :

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

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