Télécharger devfb7.eso

Retour à la liste

Numérotation des lignes :

  1. C DEVFB7 SOURCE CHAT 05/01/12 22:45:43 5004
  2. C DEVFB6 SOURCE LAVARENN 96/10/30 21:16:12 2349
  3. SUBROUTINE DEVFB7(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  4. & NPLB,IND,IND2,PDTS2,I,iannul,XCHPFB)
  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. * Calcul des forces de choc sur base B pour les liaisons de *
  13. * type LIGNE_CERCLE *
  14. * *
  15. * Paramètres: *
  16. * *
  17. * e ITYP type de la liaison. *
  18. * es FTOTB Forces extérieures totalisées sur la base B. *
  19. * e XPTB Tableau des déplacements des points *
  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. * es XVALB Tableau contenant les variables internes de liaisons. *
  24. * es XCHPFB Tableau contenant les valeurs des futurs chpoints *
  25. * e NLIAB Nombre de liaisons sur la base B. *
  26. * e NPLB Nombre total de points intervenant dans les liaisons. *
  27. * e IND Indice du pas. *
  28. * e I numéro de la liaison. *
  29. * *
  30. * *
  31. * Auteur, date de création: *
  32. * *
  33. * Ibrahim PINTO, 05/97 *
  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.  
  41.  
  42.  
  43. *
  44. * Initialisations
  45. *
  46. *
  47. XVALB(I,IND,1) =0.D0
  48. XVALB(I,IND,3) =0.D0
  49. XVALB(I,IND,4) =0.D0
  50. XVALB(I,IND,5) =0.D0
  51. XVALB(I,IND,6) =0.D0
  52. XVALB(I,IND,10) = 0.D0
  53. XVALB(I,IND,11) = 0.D0
  54. XVALB(I,IND,12) = 0.D0
  55. IDIM = IPALB(I,3)
  56. IF (ITYP.EQ.37 .OR. ITYP.EQ.39) THEN
  57. ID1 = 6
  58. ELSE
  59. ID1 = 7
  60. ENDIF
  61. NNOEES = IPALB(I,22)
  62. NNOEMA=IPALB(I,21)
  63. IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM
  64. ICH = 26 + NNOEMA+NNOEES
  65. ICG = 26 + 2*(NNOEMA+NNOEES)
  66. DO 5 J=1,(NNOEMA+NNOEES)
  67. IPALB(I,ICH+J) = 0
  68. IPALB(I,ICG+J) = 0
  69. DO 7 ID=1,IDIM
  70. XPALB(I,IFO+ID) = 0.D0
  71. 7 CONTINUE
  72. IFO = IFO + IDIM
  73. 5 CONTINUE
  74. IF (IDIM.EQ.3) THEN
  75. IDIMB=6
  76. ELSE
  77. IDIMB=3
  78. ENDIF
  79. DO 8 IP=1,NPLB
  80. XCHPFB(1,I,IND,IP)=0.D0
  81. XCHPFB(2,I,IND,IP)=0.D0
  82. 8 CONTINUE
  83. *******************************************************************
  84. * On s'intéresse au choc des noeuds esclaves sur le maillage maitre
  85. *******************************************************************
  86.  
  87.  
  88.  
  89. ILOCAL=IPALB(I,23)
  90. ISYM = IPALB(I,26)
  91.  
  92.  
  93. IF (ISYM.EQ.1 .OR. ISYM.EQ.0) THEN
  94.  
  95. ********************************************************************
  96. * On s'intéresse au choc des noeuds maitres sur le maillage esclave*
  97. ********************************************************************
  98.  
  99. * Recherche des plus proches voisins
  100. CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,ILOCAL,1)
  101. * Boucle sur tous les noeuds MAITRES
  102. DO 10 IESC=1,NNOEMA
  103. CALL DYFOR1(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB,IND
  104. &,IND2,PDTS2,I,IANNUL,IESC,1,XCHPFB)
  105. 10 CONTINUE
  106.  
  107.  
  108. ELSE
  109.  
  110.  
  111. ********************************************************************
  112. * On s'intéresse au choc des noeuds esclaves sur le maillage maitre*
  113. ********************************************************************
  114.  
  115. * Recherche des plus proches voisins
  116. CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,ILOCAL,0)
  117. * Boucle sur tous les noeuds esclaves
  118. DO 20 IESC=1,NNOEES
  119. CALL DYFOR1(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB,IND
  120. &,IND2,PDTS2,I,IANNUL,IESC,0,XCHPFB)
  121. 20 CONTINUE
  122.  
  123. ENDIF
  124.  
  125.  
  126. IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM
  127. DO 40 INOE=1,(NNOEMA+NNOEES)
  128. DO 42 ID=1,IDIM
  129. FTOTB(IPLIB(I,INOE),ID)=FTOTB(IPLIB(I,INOE),ID)+
  130. &XPALB(I,IFO+ID)
  131. 42 CONTINUE
  132. IFO = IFO+IDIM
  133. 40 CONTINUE
  134. *
  135. *
  136.  
  137. END
  138.  
  139.  
  140.  
  141.  
  142.  

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