Télécharger dyn206.eso

Retour à la liste

Numérotation des lignes :

  1. C DYN206 SOURCE BP208322 16/06/06 21:15:05 8944
  2. SUBROUTINE DYN206(I,ITLB,ITYP,KTLIAB,NPLB)
  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. * Remplissage des tableaux de description des liaisons sur *
  11. * la base à partir des informations contenues dans la *
  12. * table ILIB (liaison de type ..._PLAN). *
  13. * Liaison POINT_PLAN avec ou sans amortissement *
  14. * Liaison POINT_PLAN_FROTTEMENT avec ou sans amortissement *
  15. * Liaison CERCLE_PLAN_FROTTEMENT avec ou sans amortissement *
  16. * Liaison POINT_PLAN_FLUIDE *
  17. * *
  18. * Paramètres: *
  19. * *
  20. * e I Numéro de la liaison. *
  21. * e ITLB Table rassemblant la description d'une liaison. *
  22. * e ITYP Type de la liaison. *
  23. * s KTLIAB Segment descriptif des liaisons sur base B. *
  24. * e NPLB Nombre total de points. *
  25. * *
  26. * *
  27. * Auteur, date de création: *
  28. * *
  29. * Samuel DURAND, le 18 Octobre 1996. *
  30. * *
  31. *--------------------------------------------------------------------*
  32. -INC CCOPTIO
  33. -INC SMCOORD
  34. -INC SMELEME
  35. -INC SMCHPOI
  36. *
  37. SEGMENT MTLIAB
  38. INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  39. REAL*8 XPALB(NLIAB,NXPALB)
  40. REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  41. ENDSEGMENT
  42. *
  43. SEGMENT MLIGNE
  44. INTEGER KPLIB(NPLB)
  45. ENDSEGMENT
  46. *
  47. LOGICAL L1,L0
  48. CHARACTER*8 MONAMO,MONESC,MONREC,MONJEU,CMOT,CMOT1,MONSYM,CHARRE
  49. *
  50. MTLIAB = KTLIAB
  51. SEGINI MLIGNE
  52. *
  53. * --- choc élémentaire LIGNE_LIGNE_FROTTEMENT
  54. * avec ou sans amortissement
  55. *
  56. CALL ACCTAB(ITLB,'MOT',I0,X0,'LIGNE_MAITRE',L0,IP0,
  57. & 'MAILLAGE',I1,X1,' ',L1,IMAI)
  58. IF (IERR.NE.0) RETURN
  59. MONESC = ' '
  60. CALL ACCTAB(ITLB,'MOT',I0,X0,'LIGNE_ESCLAVE',L0,IP0,
  61. & MONESC,I1,X1,CHARRE,L1,IESC)
  62. IF (IERR.NE.0) RETURN
  63. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEURS',L0,IP0,
  64. & 'CHPOINT',I0,X1,' ',L1,IRAIES)
  65. IF (IERR.NE.0) RETURN
  66. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_GLISSEMENT',L0,IP0,
  67. & 'FLOTTANT',I0,XGLIS,' ',L1,IP1)
  68. IF (IERR.NE.0) RETURN
  69. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_ADHERENCE',L0,IP0,
  70. & 'FLOTTANT',I0,XADHE,' ',L1,IP1)
  71. IF (IERR.NE.0) RETURN
  72. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR_TANGENTIELLE',L0,IP0,
  73. & 'FLOTTANT',I0,XRAIT,' ',L1,IP1)
  74. IF (IERR.NE.0) RETURN
  75. CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT_TANGENTIEL',L0,
  76. & IP0,'FLOTTANT',I0,XAMOT,' ',L1,IP1)
  77. IF (IERR.NE.0) RETURN
  78. *
  79. MONAMO = ' '
  80. CALL ACCTAB(ITLB,'MOT',I0,X0,'AMORTISSEMENTS',L0,IP0,
  81. & MONAMO,I1,X1,CHARRE,L1,IAMOES)
  82. IF (IERR.NE.0) RETURN
  83. *
  84. MONREC = ' '
  85. CALL ACCTAB(ITLB,'MOT',I0,X0,'RECHERCHE',L0,IP0,
  86. & MONREC,I1,X1,CMOT,L1,IP1)
  87. IF (IERR.NE.0) RETURN
  88. *
  89. MONJEU = ' '
  90. CALL ACCTAB(ITLB,'MOT',I1,X0,'JEU',L0,IP0,
  91. & MONJEU,I0,XJEU,CHARRE,L1,IP1)
  92. IF (IERR.NE.0) RETURN
  93. *
  94. *bp,2016 petit message informatif pour ceux qui, comme moi, n'auraient
  95. * pas lu la notice jusqu'au bout :
  96. IF(XRAIT.LT.0.D0) THEN
  97. IF(XAMOT.LE.0D0.OR.IIMPI.GT.0) THEN
  98. WRITE(IOIMP,*) 'Liaison elementaire ..._FROTTEMENT numero',I
  99. WRITE(IOIMP,*)
  100. & 'utilisation du modele de frottement regularise d ODEN'
  101. ENDIF
  102. IF(XAMOT.LE.0D0) THEN
  103. c ERREUR: %m1:8 = %r1 inferieur a %r2
  104. MOTERR(1:8)='AMOR*_T*'
  105. REAERR(1)=XAMOT
  106. REAERR(2)=0.D0
  107. CALL ERREUR(41)
  108. RETURN
  109. ENDIF
  110. ENDIF
  111.  
  112. IPALB(I,1) = ITYP
  113. IPALB(I,3) = IDIM
  114. XPALB(I,3) = XGLIS
  115. XPALB(I,4) = XADHE
  116. XPALB(I,5) = XRAIT
  117. XPALB(I,6) = XAMOT
  118. *
  119. IF (MONAMO.EQ.'CHPOINT') THEN
  120. IPALB(I,1) = 36
  121. ID1 = 7
  122. ELSE
  123. ID1 = 6
  124. ENDIF
  125. * Normale au plan
  126. IF (IDIM.EQ.3) THEN
  127. CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  128. & 'POINT',I1,X1,' ',L1,INOR)
  129. IF (IERR.NE.0) RETURN
  130. IPNO = (IDIM + 1) * (INOR - 1)
  131. PS = 0.D0
  132. DO 80 ID = 1,IDIM
  133. XC = XCOOR(IPNO + ID)
  134. PS = PS + XC * XC
  135. 80 CONTINUE
  136. * end do
  137. IF (PS.LE.0.D0) THEN
  138. CALL ERREUR(162)
  139. RETURN
  140. ENDIF
  141. DO 81 ID=1,IDIM
  142. XPALB(I,ID1+ID) = XCOOR(IPNO + ID) / SQRT(PS)
  143. 81 CONTINUE
  144. ELSE
  145. DO 82 ID=1,IDIM
  146. XPALB(I,ID1+ID) = 0.D0
  147. 82 CONTINUE
  148. ENDIF
  149. IF (MONJEU.EQ.'FLOTTANT') THEN
  150. XPALB(I,2) = XJEU
  151. ELSE
  152. XPALB(I,2) = 0.D0
  153. ENDIF
  154. * La recherche s'effectue par défaut localement
  155. IF (MONREC.EQ.'MOT') THEN
  156. IF (CMOT(1:7).EQ.'GLOBALE') THEN
  157. IPALB(I,23) = 1
  158. ELSE
  159. IPALB(I,23) = 0
  160. ENDIF
  161. ELSE
  162. IPALB(I,23) = 0
  163. ENDIF
  164. *
  165. * Coordonnées du maillage_maitre
  166. MELEME = IMAI
  167. SEGACT MELEME
  168. * Pour savoir si le contour est fermé
  169. NELEMA = NUM(/2)
  170. IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN
  171. NNOEMA = NELEMA
  172. IFERMA = 1
  173. ELSE
  174. NNOEMA = NELEMA +1
  175. IFERMA = 0
  176. ENDIF
  177. IPALB(I,21) = NNOEMA
  178. IPALB(I,24) = IFERMA
  179. ID2 = ID1 + 4*IDIM
  180. IPT = NUM(1,1)
  181. INPT = (IDIM+1)*(IPT-1)
  182. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  183. IPLIB(I,1) = IPLAC
  184. KPLIB(1) = IPT
  185. DO 84 ID=1,IDIM
  186. XPALB(I,ID2+ID) = XCOOR(INPT+ID)
  187. 84 CONTINUE
  188. DO 85 IE=1,(NNOEMA-1)
  189. IPT = NUM(2,IE)
  190. INPT = (IDIM+1)*(IPT-1)
  191. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  192. IPLIB(I,IE+1) = IPLAC
  193. KPLIB(IE+1) = IPT
  194. IDIE = ID2 + IE*IDIM
  195. DO 86 ID=1,IDIM
  196. XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  197. 86 CONTINUE
  198. 85 CONTINUE
  199. SEGDES MELEME
  200. *
  201. * Maillage_esclave
  202. ID3 = ID2 + NNOEMA*IDIM
  203. IF (MONESC.EQ.'POINT') THEN
  204. * La ligne esclave est un point
  205. NNOEES=1
  206. IFERES=0
  207. ISYMET=-1
  208. * Lecture des coordonnées
  209. IPESC = (IDIM+1)*(IESC-1)
  210. CALL PLACE2(JPLIB,NPLB,IPLAC,IESC)
  211. IPLIB(I,NNOEMA+1) = IPLAC
  212. KPLIB(NNOEMA+1) = IESC
  213. DO 90 ID = 1,IDIM
  214. XPALB(I,ID3+ID) = XCOOR(IPESC+ID)
  215. 90 CONTINUE
  216. *
  217. IPALB(I,22) = NNOEES
  218. IPALB(I,25) = IFERES
  219. IPALB(I,26) = ISYMET
  220. ELSE
  221. IF (MONESC.EQ.'MAILLAGE') THEN
  222. * La ligne esclave est un maillage
  223. MELEME = IESC
  224. SEGACT MELEME
  225. * Pour savoir si le contour est fermé
  226. NELEES = NUM(/2)
  227. IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN
  228. NNOEES = NELEES
  229. IFERES = 1
  230. ELSE
  231. NNOEES = NELEES +1
  232. IFERES = 0
  233. ENDIF
  234. IPALB(I,22) = NNOEES
  235. IPALB(I,25) = IFERES
  236. * Coordonnées du maillage_esclave
  237. IPT = NUM(1,1)
  238. INPT = (IDIM+1)*(IPT-1)
  239. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  240. IPLIB(I,NNOEMA+1) = IPLAC
  241. KPLIB(NNOEMA+1) = IPT
  242. DO 94 ID=1,IDIM
  243. XPALB(I,ID3+ID) = XCOOR(INPT+ID)
  244. 94 CONTINUE
  245. DO 95 IE=1,(NNOEES-1)
  246. IPT = NUM(2,IE)
  247. INPT = (IDIM+1)*(IPT-1)
  248. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  249. IPLIB(I,NNOEMA+IE+1) = IPLAC
  250. KPLIB(NNOEMA+IE+1) = IPT
  251. IDIE = ID3 + IE*IDIM
  252. DO 96 ID=1,IDIM
  253. XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  254. 96 CONTINUE
  255. 95 CONTINUE
  256. SEGDES MELEME
  257. MONSYM=' '
  258. CALL ACCTAB(ITLB,'MOT',I0,X0,'SYMETRIE',L0,IP0,
  259. & MONSYM,I1,X1,CMOT1,L1,IP1)
  260. * Le traitement symétrique par défaut ne s'effectue pas
  261. IF (MONSYM.EQ.'MOT') THEN
  262. IF (CMOT1(1:7).EQ.'LOCALE') THEN
  263. IPALB(I,26) = 1
  264. ELSE
  265. IF (CMOT1(1:4).EQ.'VRAI'.OR.
  266. &CMOT1(1:7).EQ.'GLOBALE') THEN
  267. IPALB(I,26) = 0
  268. ELSE
  269. IPALB(I,26) = -1
  270. ENDIF
  271. ENDIF
  272. ELSE
  273. IPALB(I,26) = -1
  274. ENDIF
  275. ELSE
  276. * La ligne esclave n'est ni un point ni un maillage
  277. * CALL ERREUR(...)
  278. RETURN
  279. ENDIF
  280. ENDIF
  281. * Lecture des chpoints de raideur et d amortissement
  282. * Raideurs des noeuds esclaves et maitres
  283. ID4=ID1+(2*(NNOEMA+NNOEES)+4)*IDIM
  284. MCHPOI=IRAIES
  285. SEGACT,MCHPOI
  286. NSOUP=IPCHP(/1)
  287. DO 100 IPC=1,NSOUP
  288. MSOUPO=IPCHP(IPC)
  289. SEGACT,MSOUPO
  290. MELEME = IGEOC
  291. SEGACT,MELEME
  292. MPOVAL = IPOVAL
  293. SEGACT,MPOVAL
  294. NNN = NUM(/2)
  295. DO 110 INN=1,NNN
  296. IPT = NUM(1,INN)
  297. CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  298. IF (IPLAC.NE.0) THEN
  299. XPALB(I,ID4+IPLAC)=VPOCHA(INN,1)
  300. ENDIF
  301. 110 CONTINUE
  302. SEGDES,MPOVAL,MELEME
  303. SEGDES MSOUPO
  304. 100 CONTINUE
  305. SEGDES,MCHPOI
  306. * Amortissement des noeuds esclaves et maitres
  307. ID5=ID4+NNOEMA+NNOEES
  308. IF (IPALB(I,1).EQ.36) THEN
  309. MCHPOI=IAMOES
  310. SEGACT,MCHPOI
  311. NSOUP = IPCHP(/1)
  312. DO 120 IPC=1,NSOUP
  313. MSOUPO=IPCHP(IPC)
  314. SEGACT,MSOUPO
  315. MELEME = IGEOC
  316. SEGACT,MELEME
  317. MPOVAL = IPOVAL
  318. SEGACT,MPOVAL
  319. NNN=NUM(/2)
  320. DO 130 INN=1,NNN
  321. IPT = NUM(1,INN)
  322. CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  323. IF (IPLAC.NE.0) THEN
  324. XPALB(I,ID5+IPLAC)=VPOCHA(INN,1)
  325. ENDIF
  326. 130 CONTINUE
  327. SEGDES MPOVAL,MELEME
  328. SEGDES MSOUPO
  329. 120 CONTINUE
  330. SEGDES MCHPOI
  331. ENDIF
  332. SEGSUP MLIGNE
  333. * end do
  334. *
  335. *
  336. * --- choc élémentaire ..._PLAN...
  337. *
  338. * ELSE IF (ITYP.EQ. ) THEN
  339. * ...
  340. * ...
  341. *
  342. END
  343.  
  344.  
  345.  
  346.  
  347.  

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