Télécharger dycan1.eso

Retour à la liste

Numérotation des lignes :

  1. C DYCAN1 SOURCE CHAT 05/01/12 22:59:53 5004
  2. C DYCAND SOURCE LAVARENN 96/11/05 21:22:27 2357
  3. SUBROUTINE DYCAN1(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,
  4. & XXXN,XNET,XTE,XPOID,ICAND,IESC,IROLE)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. *-----------------------------------------------------------------------*
  8. * *
  9. * Opérateur DYNE : algorithme de Fu - de Vogelaere *
  10. * ________________________________________________ *
  11. * *
  12. * Pour la liaison Ligne_cercle , *
  13. * Donne le segment du maillage le plus proche du point butée , *
  14. * calcule la normale de contact, le déplacement suivant *
  15. * cette normale et la position du point de contact sur le segment *
  16. * *
  17. * *
  18. * Paramètres *
  19. * *
  20. * e IPALB Renseigne sur la liaison. *
  21. * e IPLIB Tableau contenant les numéros "DYNE" de la liaison. *
  22. * e XPALB Tableau contenant les paramètres de la liaison. * *
  23. * e XPTB Tableau des d{placements des points *
  24. * e NLIAB Nombre de liaisons sur la base B. *
  25. * e NPLB Nombre total de points intervenant dans les liaisons. *
  26. * e IND Indice du pas. *
  27. * e I numéro de la liaison. *
  28. * es ICAND Numéros 'dyne' des noeuds du segment candidat. *
  29. * es XPOID Position relative du point de contact sur le segment. *
  30. * es XXXN Normale au contact *
  31. * es XNET distance du centre du cercle(E) au point du *
  32. * segment candidat dans le plan du cercle (T) *
  33. * s XTE vecteur TE (T POINT DE CONTACT, E CENTRE DU CERCLE ) *
  34. * *
  35. * Auteur, date de création: *
  36. * *
  37. * IBRAHIM PINTO, 05/97 *
  38. * *
  39. *-----------------------------------------------------------------------*
  40. INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
  41. INTEGER ICAND(2)
  42. REAL*8 XPTB(NPLB,4,*),XPALB(NLIAB,*)
  43. REAL*8 XXMA(3),PSC(2),AE(3),AB(3), PCONT(3),XTE(3)
  44. REAL*8 XXXN(3),XXXC(2,3),U(3)
  45. *
  46.  
  47.  
  48. ITYP = IPALB(I,1)
  49. IDIM = IPALB(I,3)
  50. XRAIT = XPALB(I,5)
  51. IF (ITYP.EQ.37 .OR. ITYP.EQ.39) THEN
  52. ID1 = 6
  53. ELSE
  54. ID1 = 7
  55. ENDIF
  56. IF (IROLE.EQ.0) THEN
  57. KMAI = 0
  58. IMAI = ID1 +4*IDIM
  59. IBUT = IMAI + (IPALB(I,21))*IDIM
  60. NNOEMA= IPALB(I,21)
  61. IFERMA= IPALB(I,24)
  62. KBUT = IPALB(I,21)
  63. JVOI=26
  64. ELSE
  65. KMAI = IPALB(I,21)
  66. IBUT = ID1 + 4*IDIM
  67. IMAI = IBUT + (IPALB(I,21))*IDIM
  68. NNOEMA= IPALB(I,22)
  69. IFERMA= IPALB(I,25)
  70. KBUT = 0
  71. JVOI=26+IPALB(I,22)
  72. ENDIF
  73. IM = IPALB(I,JVOI+IESC)
  74.  
  75.  
  76.  
  77. *
  78. *****************************************
  79. * Recherche du segment candidat *
  80. *****************************************
  81. IM2 = IM +1
  82. IM1 = IM -1
  83. IDM = IMAI +(IM-1)*IDIM
  84. PXXC1 = 0.D0
  85. PXXC2 = 0.D0
  86. XLONG = 0.D0
  87. PSC(1) = 0.D0
  88. PSC(2) = 0.D0
  89. XNET = 0.D0
  90. * Prise en compte des extrémitées pour contour fermé
  91. IF (IM1.EQ.0.AND.IFERMA.EQ.1) THEN
  92. IM1 = NNOEMA
  93. ENDIF
  94. IF (IM2.EQ.(NNOEMA+1).AND.IFERMA.EQ.1) THEN
  95. IM2 = 1
  96. ENDIF
  97. IDM2 = IMAI +(IM2-1)*IDIM
  98. IDM1 = IMAI +(IM1-1)*IDIM
  99. * Tangentes au contour
  100. DO 500 ID=1,IDIM
  101. IF (IM2.NE.(NNOEMA+1)) THEN
  102. XXXC(2,ID) =XPALB(I,IDM2+ID)
  103. &+XPTB(IPLIB(I,KMAI+IM2),IND,ID)
  104. &-XPALB(I,IDM+ID)-XPTB(IPLIB(I,KMAI+IM),IND,ID)
  105. ELSE
  106. XXXC(2,ID) = -XPALB(I,IDM+ID)
  107. &-XPTB(IPLIB(I,KMAI+IM),IND,ID)
  108. &+XPALB(I,IDM1+ID)+XPTB(IPLIB(I,KMAI+IM1),IND,ID)
  109. ENDIF
  110. IF (IM1.NE.0) THEN
  111. XXXC(1,ID) = -XPALB(I,IDM+ID)
  112. &-XPTB(IPLIB(I,KMAI+IM),IND,ID)
  113. &+XPALB(I,IDM1+ID)+XPTB(IPLIB(I,KMAI+IM1),IND,ID)
  114. ELSE
  115. XXXC(1,ID) = XPALB(I,IDM2+ID)
  116. &+XPTB(IPLIB(I,KMAI+IM2),IND,ID)
  117. &-XPALB(I,IDM+ID)-XPTB(IPLIB(I,KMAI+IM),IND,ID)
  118. ENDIF
  119. PXXC1 = PXXC1 + XXXC(1,ID)*XXXC(1,ID)
  120. PXXC2 = PXXC2 + XXXC(2,ID)*XXXC(2,ID)
  121. 500 CONTINUE
  122. * Normalisation des tangentes
  123. PXXC1 = SQRT(PXXC1)
  124. PXXC2 = SQRT(PXXC2)
  125. DO 504 ID=1,IDIM
  126. XXXC(1,ID) = XXXC(1,ID)/PXXC1
  127. XXXC(2,ID) = XXXC(2,ID)/PXXC2
  128. 504 CONTINUE
  129. * Projections sur les deux segments
  130. IDESC=IBUT+(IESC-1)*IDIM
  131. DO 508 ID=1,IDIM
  132. XXMA(ID) = XPALB(I,IDESC+ID) + XPTB(IPLIB(I,KBUT+IESC),
  133. &IND,ID)- XPALB(I,IDM+ID) - XPTB(IPLIB(I,KMAI+IM),IND,ID)
  134. PSC(1) = PSC(1) + XXMA(ID)*XXXC(1,ID)
  135. PSC(2) = PSC(2) + XXMA(ID)*XXXC(2,ID)
  136. 508 CONTINUE
  137. * Choix du segment
  138. ICAND(1) = IM
  139. IF (PSC(2).GT.PSC(1)) THEN
  140. IPT = 2
  141. ICAND(2) = IM2
  142. ELSE
  143. IPT = 1
  144. ICAND(2) = IM1
  145. ENDIF
  146.  
  147.  
  148. * Pour un contour ouvert arrivee en limite
  149. * mise a zero de xnet pour indiquer qu'il n'a pas
  150. * contact
  151.  
  152. IF (ICAND(2).EQ.0) THEN
  153. ICAND(2) = 2
  154. XNET = 0
  155. ENDIF
  156. IF (ICAND(1).EQ.(NNOEMA+1)) THEN
  157. ICAND(2)= NNOEMA-1
  158. XNET=0
  159. ENDIF
  160.  
  161.  
  162.  
  163. *---position relative du point de contact sur le segment candidat
  164.  
  165.  
  166. IDCAN1 = IMAI +(ICAND(1) -1)*IDIM
  167. IDCAN2 = IMAI +(ICAND(2) -1)*IDIM
  168. PSNAE = 0.D0
  169. PSNAB = 0.D0
  170.  
  171.  
  172.  
  173. *------calcul des produits scalaires necessaires
  174.  
  175. *--------calcul des coordonnees des vecteurs icand1iesc(AE) et icand1icand2(AB)
  176.  
  177. DO 510 ID=1,IDIM
  178. AE(ID) = XPALB(I,IDESC+ID)+XPTB(IPLIB(I,KBUT+IESC),IND,
  179. &ID)-XPALB(I,IDCAN1+ID)-XPTB(IPLIB(I,KMAI+ICAND(1)),IND,ID)
  180.  
  181. AB(ID)= XPALB(I,IDCAN2+ID)+XPTB(IPLIB(I,KMAI+ICAND(2)),IND,
  182. &ID)-XPALB(I,IDCAN1+ID)-XPTB(IPLIB(I,KMAI+ICAND(1)),IND,ID)
  183. 510 CONTINUE
  184.  
  185.  
  186.  
  187. *------calcul des produits scalaires
  188. *------AVEC LA NORMALE AU PLAN DU CERCLE
  189.  
  190. DO 512 ID=1,IDIM
  191. PSNAE=PSNAE+XPALB(I,ID1+ID)*AE(ID)
  192. PSNAB=PSNAB+XPALB(I,ID1+ID)*AB(ID)
  193. 512 CONTINUE
  194.  
  195. *------CALCUL DE LA POSITION RELATIVE DU POINT DU
  196. *------SEGMENT DANS LE PLAN DU CERCLE(ORIGINE:LE+PROCHE VOISIN MAITRE)
  197.  
  198. XNHU=0.D0
  199. XNHU=PSNAE/PSNAB
  200.  
  201.  
  202.  
  203. IF (XNHU.GE.0) THEN
  204.  
  205.  
  206. *------CALCUL DES COORDONNES CARTESIENNES
  207. *------DU "POINT DE CONTACT POTENTIEL"(POINT T)
  208.  
  209. DO 514 ID=1,IDIM
  210. PCONT(ID)=0.D0
  211. PCONT(ID)=(1-XNHU)*(XPALB(I,IDCAN1+ID)
  212. &+XPTB(IPLIB(I,KMAI+ICAND(1)),IND,ID))+
  213. &XNHU*(XPALB(I,IDCAN2+ID)
  214. &+XPTB(IPLIB(I,KMAI+ICAND(2)),IND,ID))
  215. 514 CONTINUE
  216.  
  217.  
  218. *-----CALCUL DE LA DISTANCE ENTRE LE NOEUD ESCLAVE(CENTRE DU CERCLE)
  219. *-----ET LE POINT DU SEGMENT DANS LE PLAN DU CERCLE( DISTANCE ET)
  220.  
  221. XNET=0.D0
  222. PSET2=0.D0
  223.  
  224.  
  225.  
  226.  
  227. DO 516 ID=1,IDIM
  228. XA=-PCONT(ID)
  229. XB=XPALB(I,IDESC+ID)
  230. XC=XPTB(IPLIB(I,KBUT+IESC),IND,ID)
  231. XTE(ID)=XA+XB+XC
  232. * XTE(ID)=-PCONT(ID)+XPALB(I,IDESC+ID)+XPTB(IPLIB(I,KBUT+IESC),
  233. * &IND,ID)
  234. PSET2=PSET2+XTE(ID)*XTE(ID)
  235.  
  236.  
  237.  
  238. 516 CONTINUE
  239.  
  240.  
  241. XNET=SQRT(PSET2)
  242.  
  243.  
  244. *-----CALCUL DU POIDS EN CAS DE CONTACT
  245.  
  246. XPOID=0.D0
  247. XRAY=XPALB(I,2)
  248.  
  249. IF (XNET.GE.XRAY) THEN
  250. XPOID=1-XNHU
  251. ENDIF
  252.  
  253. ELSE
  254. *--------SINON TOUT SE PASSE COMME S'IL N'Y AVAIT
  255. *--------PAS CONTACT;ON MET XNET A ZERO
  256.  
  257. XNET=0.D0
  258.  
  259. ENDIF
  260.  
  261. *----ENDIF DU XNHU.GE.0
  262.  
  263.  
  264.  
  265.  
  266. *-----CALCUL DE LA NORMALE AU PLAN DE CONTACT
  267.  
  268.  
  269. IF (ITYP.EQ.37 .OR. ITYP.EQ.38) THEN
  270. *-----SI ON SUPPOSE LA NORMALE DANS LE PLAN DU CERCLE
  271. *-----NORMALE=TE, ON NE DIFFERENCIE PAS CAS 2D ET 3D(SANREAC)
  272.  
  273. DO 517 ID=1,IDIM
  274. XXXN(ID)=XTE(ID)/XNET
  275. 517 CONTINUE
  276.  
  277.  
  278.  
  279. ELSE
  280.  
  281. *-----DANS LE CAS GENERAL (REACNOR)
  282. *-----ON A BESOIN DE LA NORMALE AU PLAN ABE
  283.  
  284. PSN=0.D0
  285. PSN2=0.D0
  286.  
  287. *-------CALCUL DE LA NORMALE AU PLAN ABE(U)
  288. IF (IDIM.EQ.3) THEN
  289. U(1)=AB(2)*AE(3)-AB(3)*AE(2)
  290. U(2)=AB(3)*AE(1)-AB(1)*AE(3)
  291. U(3)=AB(1)*AE(2)-AB(2)*AE(1)
  292.  
  293.  
  294. *-------CALCUL DE LA NORMALE AU PLAN DE CONTACT EN 3D
  295.  
  296. XXXN(1)=U(2)*AB(3)-U(3)*AB(2)
  297. XXXN(2)=U(3)*AB(1)-U(1)*AB(3)
  298. XXXN(3)=U(1)*AB(2)-U(2)*AB(1)
  299.  
  300.  
  301. ELSE
  302.  
  303. *-------calcul de la normale en 2d
  304. XXXN(1)=-(AB(1)*AE(2)-AB(2)*AE(1))*AB(2)
  305. XXXN(2)=(AB(1)*AE(2)-AB(2)*AE(1))*AB(1)
  306. ENDIF
  307.  
  308. *-------NORMALISATION,INDEPENDANTE DE LA DIMENSION
  309. DO 522 ID=1,IDIM
  310. PSN2=PSN2 + XXXN(ID)*XXXN(ID)
  311. 522 CONTINUE
  312. PSN=SQRT(PSN2)
  313. DO 524 ID=1,IDIM
  314. XXXN(ID)=XXXN(ID)/PSN
  315. 524 CONTINUE
  316.  
  317. ENDIF
  318.  
  319.  
  320.  
  321.  
  322.  
  323. C
  324.  
  325. END
  326.  
  327.  
  328.  
  329.  
  330.  

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