Télécharger cucbkp.eso

Retour à la liste

Numérotation des lignes :

  1. C CUCBKP SOURCE CHAT 07/10/22 21:15:38 5921
  2. SUBROUTINE CUCBKP(IFACE,BKSIP,XNOE,B,AJAC)
  3. implicit real*8(A-H,O-Z)
  4. implicit integer(I-N)
  5.  
  6. *
  7. * ------------------------------------------------------------------
  8. * CALCUL DE LA MATRICE B AU POINT D INTEGRATION DONNNE
  9. *
  10. * H. BUNG 06-98
  11. * ------------------------------------------------------------------
  12. *
  13. * ENTREES :
  14. * XNOE(24) : COORDONNEES DES NOEUDS
  15. * IPINT : NO DU POINT D INTEGRATION
  16. * MOT : NOM DE L ELEMENT FINI
  17. * SORTIE
  18. * B(NBLIB,NBN) : MATRICE B
  19. * AJAC : JACOBIEN
  20. *
  21. * IMPLICIT NONE
  22. *
  23. * REAL *8 XNOE(24),BKSIP(3,4)
  24. * REAL *8 B(3,4),AJAC
  25. * INTEGER IFACE
  26. dimension XNOE(24),BKSIP(3,4),B(3,4)
  27.  
  28. *
  29. *---- VARIABLES LOCALES
  30. *
  31. * REAL *8 DJ(3,3),UJ(3,3)
  32. * INTEGER LRET,I,J,K,NBN,IDECALAGE
  33. dimension DJ(3,3),UJ(3,3)
  34. *
  35. NBN = 4
  36. IF(IFACE.EQ.1)THEN
  37. IDECALAGE=0
  38. ENDIF
  39. IF(IFACE.EQ.2)THEN
  40. IDECALAGE=12
  41. ENDIF
  42. IF(IFACE.NE.1.AND.IFACE.NE.2) THEN
  43. WRITE(6,*)'******** FACE NON DEFINIE DANS CUB_CALB_KP *******'
  44. call erreur(5)
  45. STOP
  46. ENDIF
  47. *
  48. *--- DJ = BKSIP * TRANSPOSE(XNOE)
  49. *
  50. DO I=1,3
  51. DO J=1,3
  52. DJ(I,J) = 0.
  53. END DO
  54. END DO
  55. DO I=1,3
  56. DO J=1,3
  57. DO K=1,NBN
  58. DJ(J,I)=DJ(J,I)+BKSIP(J,K)*XNOE(IDECALAGE+(K-1)*3+I)
  59. END DO
  60. END DO
  61. END DO
  62. *
  63. *----- UJ(J,I) MATRICE INVERSE DE DJ(J,I)
  64. *
  65. CALL INV33(DJ,UJ,AJAC,LRET)
  66. C TEST SI ELEMENT TROP DEFORME: CROISEMENT
  67.  
  68. AJAC=ABS(AJAC)
  69. *
  70. *----- MATRICE ( B ) = UJ * BKSIP
  71. *
  72. DO I=1,3
  73. DO J=1,NBN
  74. B(I,J)=0.
  75. END DO
  76. END DO
  77. DO K=1,3
  78. DO J=1,3
  79. DO I=1,NBN
  80. B(J,I)=B(J,I)+UJ(J,K)*BKSIP(K,I)
  81. END DO
  82. END DO
  83. END DO
  84. *
  85. END
  86.  
  87.  
  88.  

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