Télécharger dyvois.eso

Retour à la liste

Numérotation des lignes :

  1. C DYVOIS SOURCE CHAT 05/01/12 23:19:23 5004
  2. SUBROUTINE DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,
  3. & ILOCAL,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 ,ligne_cercle *
  12. * Donne le noeud du maillage maitre ,le plus proche de chaque , *
  13. * point esclave *
  14. * *
  15. * Paramètres *
  16. * *
  17. * e IPALB Renseigne sur la liaison. *
  18. * e IPLIB Tableau contenant les numéros "DYNE" de la liaison. *
  19. * e XPALB Tableau contenant les paramètres de la liaison. * *
  20. * e XPTB Tableau des d{placements des points *
  21. * e NLIAB Nombre de liaisons sur la base B. *
  22. * e NPLB Nombre total de points intervenant dans les liaisons. *
  23. * e IND Indice du pas. *
  24. * e I numéro de la liaison. *
  25. * e ILOCAL Indicateur d'une recherche locale (0) ou globale (1) sur *
  26. * les noeuds du maillage. *
  27. * e IROLE Indique quel est le maillage maitre et le maillage *
  28. * esclave *
  29. * *
  30. * *
  31. * Auteur, date de création: *
  32. * *
  33. * Samuel DURAND : le 08 Aout 1996 : Création *
  34. * Ibrahim Pinto, 05/97 , liaisons ligne_cercle *
  35. *-----------------------------------------------------------------------*
  36. *************************************************************************
  37. * *
  38. INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
  39. REAL*8 XPTB(NPLB,4,*),XPALB(NLIAB,*)
  40. REAL*8 XPCOM(3),XPCOB(3)
  41.  
  42. *
  43. ITYP = IPALB(I,1)
  44. IDIM = IPALB(I,3)
  45. IF (ITYP.EQ.35 .OR. ITYP.EQ.37 .OR. ITYP.EQ.39) THEN
  46. ID1 = 6
  47. ELSE
  48. ID1 = 7
  49. ENDIF
  50. IF (IROLE.EQ.0) THEN
  51. KMAI = 0
  52. IMAI = ID1 +4*IDIM
  53. IBUT = IMAI + (IPALB(I,21))*IDIM
  54. NNOEMA = IPALB(I,21)
  55. NNOEES = IPALB(I,22)
  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. NNOEES = IPALB(I,21)
  65. IFERMA = IPALB(I,25)
  66. KBUT = 0
  67. JVOI = 26+IPALB(I,22)
  68. ENDIF
  69. *
  70. IF (ILOCAL.EQ.0) THEN
  71. *
  72. DO 100 IESC=1,NNOEES
  73. *
  74. IDESC = IBUT+(IESC-1)*IDIM
  75. IFMOIN = 1
  76. IFPLUS = 1
  77. * Recherche locale
  78. IM = IPALB(I,JVOI+IESC)
  79. XPOS = 0.D0
  80. DO 400 ID=1,IDIM
  81. IDM = IMAI + (IM-1)*IDIM + ID
  82. XPCOM(ID) = XPALB(I,IDM) +XPTB(IPLIB(I,KMAI+IM),IND,ID)
  83. XPCOB(ID) = XPALB(I,IDESC+ID)+XPTB(IPLIB(I,KBUT+IESC),
  84. &IND,ID)
  85. XPOS = XPOS +(XPCOM(ID)-XPCOB(ID))*(XPCOM(ID)-XPCOB(ID))
  86. 400 CONTINUE
  87. XPOS = SQRT(XPOS)
  88. XREF = XPOS
  89. IREF = IM
  90. IPLUS = IM+1
  91. IMOIN = IM-1
  92. 410 CONTINUE
  93. IF (IMOIN.EQ.0) THEN
  94. IF (IFERMA.EQ.0) THEN
  95. IFMOIN = 0
  96. ELSE
  97. IMOIN = NNOEMA
  98. ENDIF
  99. ENDIF
  100. IF (IPLUS.EQ.(NNOEMA+1)) THEN
  101. IF (IFERMA.EQ.0) THEN
  102. IFPLUS = 0
  103. ELSE
  104. IPLUS = 1
  105. ENDIF
  106. ENDIF
  107. IF (IFMOIN.NE.0) THEN
  108. XPOS = 0.D0
  109. DO 412 ID=1,IDIM
  110. IDL = IMAI + (IMOIN-1)*IDIM + ID
  111. XPCOM(ID) = XPALB(I,IDL)
  112. &+XPTB(IPLIB(I,KMAI+IMOIN),IND,ID)
  113. XPCOB(ID) = XPALB(I,IDESC+ID)
  114. &+XPTB(IPLIB(I,KBUT+IESC),IND,ID)
  115. XPOS = XPOS +(XPCOM(ID)-XPCOB(ID))*
  116. &(XPCOM(ID)-XPCOB(ID))
  117. 412 CONTINUE
  118. XPOS = SQRT(XPOS)
  119. IF (XPOS.LT.XREF) THEN
  120. XREF = XPOS
  121. IREF = IMOIN
  122. IMOIN = IMOIN-1
  123. ELSE
  124. IFMOIN = 0
  125. ENDIF
  126. ENDIF
  127. IF (IFPLUS.NE.0) THEN
  128. XPOS = 0.D0
  129. DO 414 ID=1,IDIM
  130. IDN = IMAI + (IPLUS-1)*IDIM + ID
  131. XPCOM(ID) = XPALB(I,IDN)
  132. &+XPTB(IPLIB(I,KMAI+IPLUS),IND,ID)
  133. XPCOB(ID) = XPALB(I,IDESC+ID)
  134. &+XPTB(IPLIB(I,KBUT+IESC),IND,ID)
  135. XPOS = XPOS +(XPCOM(ID)-XPCOB(ID))*
  136. &(XPCOM(ID)-XPCOB(ID))
  137. 414 CONTINUE
  138. XPOS = SQRT(XPOS)
  139. IF (XPOS.LT.XREF) THEN
  140. XREF = XPOS
  141. IREF = IPLUS
  142. IPLUS = IPLUS+1
  143. ELSE
  144. IFPLUS = 0
  145. ENDIF
  146. ENDIF
  147. IF ((IFMOIN.EQ.0).AND.(IFPLUS.EQ.0)) GOTO 420
  148. GOTO 410
  149. 420 CONTINUE
  150. IPALB(I,JVOI+IESC) = IREF
  151. *
  152. 100 CONTINUE
  153. ELSE
  154. DO 200 IESC=1,NNOEES
  155. * Recherche globale
  156. XPOS = 0.D0
  157. * Premier noeud du maillage
  158. IDESC = IBUT+(IESC-1)*IDIM
  159. DO 422 ID=1,IDIM
  160. IDM = IMAI + ID
  161. XPCOM(ID) = XPALB(I,IDM) +XPTB(IPLIB(I,KMAI+1),IND,ID)
  162. XPCOB(ID) = XPALB(I,IDESC+ID)+XPTB(IPLIB(I,KBUT+IESC),
  163. &IND,ID)
  164. XPOS = XPOS +(XPCOM(ID)-XPCOB(ID))*(XPCOM(ID)-XPCOB(ID))
  165. 422 CONTINUE
  166. XREF = XPOS
  167. IREF = 1
  168. DO 424 IM=2,NNOEMA
  169. XPOS = 0.D0
  170. DO 426 ID=1,IDIM
  171. IDM = IMAI + (IM-1)*IDIM + ID
  172. XPCOM(ID) = XPALB(I,IDM) +XPTB(IPLIB(I,KMAI+IM),
  173. &IND,ID)
  174. XPCOB(ID) = XPALB(I,IDESC+ID)
  175. &+XPTB(IPLIB(I,KBUT+IESC),IND,ID)
  176. XPOS = XPOS +(XPCOM(ID)-XPCOB(ID))*
  177. &(XPCOM(ID)-XPCOB(ID))
  178. 426 CONTINUE
  179. XPOS = SQRT(XPOS)
  180. IF (XPOS.LT.XREF) THEN
  181. XREF = XPOS
  182. IREF = IM
  183. ENDIF
  184. 424 CONTINUE
  185. IPALB(I,JVOI+IESC) = IREF
  186. 200 CONTINUE
  187. ENDIF
  188. *
  189.  
  190. END
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  

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