Télécharger dycand.eso

Retour à la liste

Numérotation des lignes :

  1. C DYCAND SOURCE CHAT 05/01/12 22:59:59 5004
  2. SUBROUTINE DYCAND(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,
  3. & XXXN,XDEP,XPOID,ICAND,IESC,IROLE)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. *-----------------------------------------------------------------------*
  7. * *
  8. * Opérateur DYNE : algorithme de Fu - de Vogelaere *
  9. * ________________________________________________ *
  10. * *
  11. * Pour la liaison Ligne_Ligne , *
  12. * Donne le segment du maillage le plus proche du point butée , *
  13. * calcule la normale intérieure au segment, le déplacement suivant *
  14. * cette normale et la position du point de contact sur le segment *
  15. * *
  16. * *
  17. * Paramètres *
  18. * *
  19. * e IPALB Renseigne sur la liaison. *
  20. * e IPLIB Tableau contenant les numéros "DYNE" de la liaison. *
  21. * e XPALB Tableau contenant les paramètres de la liaison. * *
  22. * e XPTB Tableau des d{placements des points *
  23. * e NLIAB Nombre de liaisons sur la base B. *
  24. * e NPLB Nombre total de points intervenant dans les liaisons. *
  25. * e IND Indice du pas. *
  26. * e I numéro de la liaison. *
  27. * es ICAND Numéros 'dyne' des noeuds du segment candidat. *
  28. * es XPOID Position relative du point de contact sur le segment. *
  29. * es XXXN Normale intérieur au segment candidat. *
  30. * es XDEP Déplacement suivant la normale. *
  31. * *
  32. * *
  33. * Auteur, date de création: *
  34. * *
  35. * Samuel DURAND : le 08 Aout 1996 : Création *
  36. * *
  37. *-----------------------------------------------------------------------*
  38. INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
  39. INTEGER ICAND(2)
  40. REAL*8 XPTB(NPLB,4,*),XPALB(NLIAB,*)
  41. REAL*8 XXMA(3),PSC(2)
  42. REAL*8 XXXN(3),XXXC(2,3)
  43. *
  44. ITYP = IPALB(I,1)
  45. IDIM = IPALB(I,3)
  46. IF (ITYP.EQ.35) THEN
  47. ID1 = 6
  48. ELSE
  49. ID1 = 7
  50. ENDIF
  51. IF (IROLE.EQ.0) THEN
  52. KMAI = 0
  53. IMAI = ID1 +4*IDIM
  54. IBUT = IMAI + (IPALB(I,21))*IDIM
  55. NNOEMA= IPALB(I,21)
  56. IFERMA= IPALB(I,24)
  57. KBUT = IPALB(I,21)
  58. JVOI=26
  59. ELSE
  60. KMAI = IPALB(I,21)
  61. IBUT = ID1 + 4*IDIM
  62. IMAI = IBUT + (IPALB(I,21))*IDIM
  63. NNOEMA= IPALB(I,22)
  64. IFERMA= IPALB(I,25)
  65. KBUT = 0
  66. JVOI=26+IPALB(I,22)
  67. ENDIF
  68. IM = IPALB(I,JVOI+IESC)
  69. *
  70. *****************************************
  71. * Recherche du segment candidat *
  72. *****************************************
  73. IM2 = IM +1
  74. IM1 = IM -1
  75. IDM = IMAI +(IM-1)*IDIM
  76. PXXC1 = 0.D0
  77. PXXC2 = 0.D0
  78. XLONG = 0.D0
  79. PSC(1) = 0.D0
  80. PSC(2) = 0.D0
  81. XDEP = 0.D0
  82. * Prise en compte des extrémitées pour contour fermé
  83. IF (IM1.EQ.0.AND.IFERMA.EQ.1) THEN
  84. IM1 = NNOEMA
  85. ENDIF
  86. IF (IM2.EQ.(NNOEMA+1).AND.IFERMA.EQ.1) THEN
  87. IM2 = 1
  88. ENDIF
  89. IDM2 = IMAI +(IM2-1)*IDIM
  90. IDM1 = IMAI +(IM1-1)*IDIM
  91. * Tangentes au contour
  92. DO 500 ID=1,IDIM
  93. IF (IM2.NE.(NNOEMA+1)) THEN
  94. XXXC(2,ID) =XPALB(I,IDM2+ID)
  95. &+XPTB(IPLIB(I,KMAI+IM2),IND,ID)
  96. &-XPALB(I,IDM+ID)-XPTB(IPLIB(I,KMAI+IM),IND,ID)
  97. ELSE
  98. XXXC(2,ID) = XPALB(I,IDM+ID)
  99. &+XPTB(IPLIB(I,KMAI+IM),IND,ID)
  100. &-XPALB(I,IDM1+ID)-XPTB(IPLIB(I,KMAI+IM1),IND,ID)
  101. ENDIF
  102. IF (IM1.NE.0) THEN
  103. XXXC(1,ID) = XPALB(I,IDM+ID)
  104. &+XPTB(IPLIB(I,KMAI+IM),IND,ID)
  105. &-XPALB(I,IDM1+ID)-XPTB(IPLIB(I,KMAI+IM1),IND,ID)
  106. ELSE
  107. XXXC(1,ID) = XPALB(I,IDM2+ID)
  108. &+XPTB(IPLIB(I,KMAI+IM2),IND,ID)
  109. &-XPALB(I,IDM+ID)-XPTB(IPLIB(I,KMAI+IM),IND,ID)
  110. ENDIF
  111. PXXC1 = PXXC1 + XXXC(1,ID)*XXXC(1,ID)
  112. PXXC2 = PXXC2 + XXXC(2,ID)*XXXC(2,ID)
  113. 500 CONTINUE
  114. * Normalisation des tangentes
  115. PXXC1 = SQRT(PXXC1)
  116. PXXC2 = SQRT(PXXC2)
  117. DO 504 ID=1,IDIM
  118. XXXC(1,ID) = XXXC(1,ID)/PXXC1
  119. XXXC(2,ID) = XXXC(2,ID)/PXXC2
  120. 504 CONTINUE
  121. * Projections sur les deux segments
  122. IDESC=IBUT+(IESC-1)*IDIM
  123. DO 508 ID=1,IDIM
  124. XXMA(ID) = XPALB(I,IDESC+ID) + XPTB(IPLIB(I,KBUT+IESC),
  125. &IND,ID)- XPALB(I,IDM+ID) - XPTB(IPLIB(I,KMAI+IM),IND,ID)
  126. PSC(1) = PSC(1) - XXMA(ID)*XXXC(1,ID)
  127. PSC(2) = PSC(2) + XXMA(ID)*XXXC(2,ID)
  128. 508 CONTINUE
  129. * Choix du segment
  130. ICAND(1) = IM
  131. IF (PSC(2).GT.PSC(1)) THEN
  132. IPT = 2
  133. ICAND(2) = IM2
  134. ELSE
  135. IPT = 1
  136. ICAND(2) = IM1
  137. ENDIF
  138. * Normale extérieure retenue
  139. IF (IDIM.EQ.3) THEN
  140. XXXN(1) = XPALB(I,ID1+2)*XXXC(IPT,3)-XPALB(I,ID1+3)*
  141. &XXXC(IPT,2)
  142. XXXN(2) = XPALB(I,ID1+3)*XXXC(IPT,1)-XPALB(I,ID1+1)*
  143. &XXXC(IPT,3)
  144. XXXN(3) = XPALB(I,ID1+1)*XXXC(IPT,2)-XPALB(I,ID1+2)*
  145. &XXXC(IPT,1)
  146. ELSE
  147. XXXN(1) = -XXXC(IPT,2)
  148. XXXN(2) = XXXC(IPT,1)
  149. ENDIF
  150. * Projection sur la normale
  151. DO 510 ID=1,IDIM
  152. XDEP = XDEP + XXMA(ID)*XXXN(ID)
  153. 510 CONTINUE
  154. * Pour un contour ouvert,arrivée en limite
  155. IF (ICAND(2).EQ.0) THEN
  156. ICAND(2) = 2
  157. XDEP = - ABS(XDEP)
  158. ENDIF
  159. IF (ICAND(2).EQ.(NNOEMA+1)) THEN
  160. ICAND(2) = NNOEMA-1
  161. XDEP = - ABS(XDEP)
  162. ENDIF
  163. * En cas de pénétration ,on récupère le poids associé
  164. XPOID = 0
  165. IF (XDEP.GE.0) THEN
  166. IF (PSC(IPT).GE.0) THEN
  167. IDCAN1 = IMAI +(ICAND(1) -1)*IDIM
  168. IDCAN2 = IMAI +(ICAND(2) -1)*IDIM
  169. DO 512 ID=1,IDIM
  170. * Longueur du segment
  171. XAIDE = (XPALB(I,IDCAN1+ID)
  172. &+XPTB(IPLIB(I,KMAI+ICAND(1)),IND,ID)-XPALB(I,IDCAN2+ID)
  173. &-XPTB(IPLIB(I,KMAI+ICAND(2)),IND,ID))
  174. XLONG = XLONG + XAIDE*XAIDE
  175. 512 CONTINUE
  176. XLONG = SQRT(XLONG)
  177. XPOID = (1-PSC(IPT)/XLONG)
  178. ELSE
  179. PS = 0.D0
  180. DO 514 ID=1,IDIM
  181. PS = PS + XXMA(ID)*XXMA(ID)
  182. 514 CONTINUE
  183. PS = SQRT(PS)
  184. DO 516 ID=1,IDIM
  185. XXXN(ID) = XXMA(ID)/PS
  186. 516 CONTINUE
  187. XPOID = 1
  188. ENDIF
  189. ENDIF
  190. END
  191.  
  192.  
  193.  

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