Télécharger dyn206.eso

Retour à la liste

Numérotation des lignes :

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

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