Télécharger la plaquette Cast3M


fr en

Télécharger cucbkp.eso

Retour à la liste

Numérotation des lignes : 

cucbkp

  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