Télécharger devfb6.eso

Retour à la liste

Numérotation des lignes :

  1. C DEVFB6 SOURCE CHAT 05/01/12 22:45:39 5004
  2. SUBROUTINE DEVFB6(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  3. & NPLB,IND,IND2,PDTS2,I,iannul,XCHPFB)
  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. * Calcul des forces de choc sur base B pour les liaisons de *
  12. * type LIGNE_LIGNE *
  13. * *
  14. * Paramètres: *
  15. * *
  16. * e ITYP type de la liaison. *
  17. * es FTOTB Forces extérieures totalisées sur la base B. *
  18. * e XPTB Tableau des déplacements des points *
  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. * es XVALB Tableau contenant les variables internes de liaisons. *
  23. * es XCHPFB Tableau contenant les valeurs des futurs chpoints *
  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. * *
  29. * *
  30. * Auteur, date de création: *
  31. * *
  32. * Samuel DURAND : le 18 Octobre 1996 : Création *
  33. * *
  34. *--------------------------------------------------------------------*
  35. *
  36. INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
  37. REAL*8 XPALB(NLIAB,*),XPTB(NPLB,4,*),FTOTB(NPLB,*)
  38. REAL*8 XVALB(NLIAB,4,*),XCHPFB(2,NLIAB,4,*)
  39. *
  40. * Initialisations
  41. *
  42. *
  43. XVALB(I,IND,1) =0.D0
  44. XVALB(I,IND,3) =0.D0
  45. XVALB(I,IND,4) =0.D0
  46. XVALB(I,IND,5) =0.D0
  47. XVALB(I,IND,6) =0.D0
  48. XVALB(I,IND,10) = 0.D0
  49. XVALB(I,IND,11) = 0.D0
  50. XVALB(I,IND,12) = 0.D0
  51. IDIM = IPALB(I,3)
  52. IF (ITYP.EQ.35) THEN
  53. ID1 = 6
  54. ELSE
  55. ID1 = 7
  56. ENDIF
  57. NNOEES = IPALB(I,22)
  58. NNOEMA=IPALB(I,21)
  59. IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM
  60. ICH = 26 + NNOEMA+NNOEES
  61. ICG = 26 + 2*(NNOEMA+NNOEES)
  62. DO 5 J=1,(NNOEMA+NNOEES)
  63. IPALB(I,ICH+J) = 0
  64. IPALB(I,ICG+J) = 0
  65. DO 7 ID=1,IDIM
  66. XPALB(I,IFO+ID) = 0.D0
  67. 7 CONTINUE
  68. IFO = IFO + IDIM
  69. 5 CONTINUE
  70. IF (IDIM.EQ.3) THEN
  71. IDIMB=6
  72. ELSE
  73. IDIMB=3
  74. ENDIF
  75. DO 8 IP=1,NPLB
  76. XCHPFB(1,I,IND,IP)=0.D0
  77. XCHPFB(2,I,IND,IP)=0.D0
  78. 8 CONTINUE
  79. *******************************************************************
  80. * On s'intéresse au choc des noeuds esclaves sur le maillage maitre
  81. *******************************************************************
  82. ILOCAL=IPALB(I,23)
  83. * Recherche des plus proches voisins
  84. CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,ILOCAL,0)
  85. * Boucle sur tous les noeuds esclaves
  86. DO 10 IESC=1,NNOEES
  87. CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB,IND
  88. &,IND2,PDTS2,I,IANNUL,IESC,0,XCHPFB)
  89. 10 CONTINUE
  90. ***************************
  91. * Traitement symétrique
  92. ***************************
  93. ISYM=IPALB(I,26)
  94. IF (ISYM.EQ.0.OR.ISYM.EQ.1) THEN
  95. * On renverse les roles du maitre et de l esclave
  96. CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,ILOCAL,1)
  97. IF (ISYM.EQ.0) THEN
  98. * symétrie globale
  99. * boucle sur tous les noeuds maitres
  100. DO 20 IMAI=1,NNOEMA
  101. CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB,IND
  102. &,IND2,PDTS2,I,IANNUL,IMAI,1,XCHPFB)
  103. 20 CONTINUE
  104. ELSE
  105. * symétrie locale
  106. *
  107. *
  108. IREF=1
  109. INOE=1
  110. ICH = 26 + NNOEES+NNOEMA
  111. ICG = 26 + 2*(NNOEES+NNOEMA)
  112. 30 CONTINUE
  113. IF (IPALB(I,ICH+INOE).EQ.1) THEN
  114. * Ce noeud a précédemment été sollicité
  115. CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB,
  116. &IND,IND2,PDTS2,I,IANNUL,INOE,1,XCHPFB)
  117. IMOINS=INOE-1
  118. 35 CONTINUE
  119. IF (IMOINS.NE.0.AND.IMOINS.NE.IREF) THEN
  120. * On regarde avant
  121. CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB,
  122. &NLIAB,NPLB,IND,IND2,PDTS2,I,IANNUL,IMOINS,1,XCHPFB)
  123. IAPRES=IPALB(I,ICG+IMOINS)+IPALB(I,ICH+IMOINS)
  124. IF (IAPRES.GT.IPALB(I,ICH+IMOINS)) THEN
  125. IMOINS=IMOINS-1
  126. GOTO 35
  127. ENDIF
  128. ENDIF
  129. INOE=INOE+1
  130. 36 CONTINUE
  131. * On regarde apres
  132. CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB,
  133. &NLIAB,NPLB,IND,IND2,PDTS2,I,IANNUL,INOE,1,XCHPFB)
  134. IAPRES=IPALB(I,ICH+INOE)+IPALB(I,ICG+INOE)
  135. IF (IAPRES.GT.IPALB(I,ICH+INOE)) THEN
  136. IF (INOE.NE.NNOEMA) THEN
  137. INOE=INOE+1
  138. GOTO 36
  139. ENDIF
  140. ELSE
  141. IREF=INOE
  142. IF (INOE.NE.NNOEMA) THEN
  143. INOE=INOE+1
  144. GOTO 30
  145. ENDIF
  146. ENDIF
  147. ELSE
  148. IF (INOE.NE.NNOEMA) THEN
  149. INOE=INOE+1
  150. GOTO 30
  151. ENDIF
  152. ENDIF
  153. ENDIF
  154. * On pondère les forces
  155. ICH = 26 + NNOEES+NNOEMA
  156. ICG = 26 + 2*(NNOEES+NNOEMA)
  157. IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM
  158. DO 21 INOE=1,(NNOEES+NNOEMA)
  159. IPALB(I,ICH+INOE)=IPALB(I,ICH+INOE)+IPALB(I,ICG+INOE)
  160. IF (IPALB(I,ICH+INOE).EQ.2) THEN
  161. DO 22 ID=1,IDIM
  162. FTOTB(IPLIB(I,INOE),ID)=FTOTB(IPLIB(I,INOE),ID)+
  163. &XPALB(I,IFO+ID)/2.
  164. 22 CONTINUE
  165. XCHPFB(1,I,IND,IPLIB(I,INOE))=
  166. &XCHPFB(1,I,IND,IPLIB(I,INOE))/2.
  167. XCHPFB(2,I,IND,IPLIB(I,INOE))=
  168. &XCHPFB(2,I,IND,IPLIB(I,INOE))/2.
  169. ELSE
  170. DO 23 ID=1,IDIM
  171. FTOTB(IPLIB(I,INOE),ID)=FTOTB(IPLIB(I,INOE),ID)+
  172. &XPALB(I,IFO+ID)
  173. 23 CONTINUE
  174. ENDIF
  175. IFO = IFO+IDIM
  176. 21 CONTINUE
  177. ELSE
  178. ******************
  179. * pas de symétrie
  180. ******************
  181. IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM
  182. DO 40 INOE=1,(NNOEMA+NNOEES)
  183. DO 42 ID=1,IDIM
  184. FTOTB(IPLIB(I,INOE),ID)=FTOTB(IPLIB(I,INOE),ID)+
  185. &XPALB(I,IFO+ID)
  186. 42 CONTINUE
  187. IFO = IFO+IDIM
  188. 40 CONTINUE
  189. *
  190. *
  191. ENDIF
  192. *
  193. *
  194. END
  195.  
  196.  
  197.  

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