Esope source files

   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 *******'
  43 :          call erreur(5) 
  44 :          STOP 
  45 :       ENDIF 
  46 : * 
  47 : *---   DJ = BKSIP * TRANSPOSE(XNOE) 
  48 : * 
  49 :       DO I=1,3 
  50 :          DO J=1,3 
  51 :             DJ(I,J) = 0. 
  52 :          END DO 
  53 :       END DO 
  54 :       DO I=1,3 
  55 :          DO J=1,3 
  56 :             DO K=1,NBN 
  57 :                DJ(J,I)=DJ(J,I)+BKSIP(J,K)*XNOE(IDECALAGE+(K-1)*3+I) 
  58 :             END DO 
  59 :          END DO 
  60 :       END DO 
  61 : * 
  62 : *-----   UJ(J,I)  MATRICE INVERSE DE DJ(J,I) 
  63 : * 
  63 :       CALL INV33(DJ,UJ,AJAC,LRET) 
  64 : C TEST SI ELEMENT TROP DEFORME: CROISEMENT 
  65 :  
  66 :       AJAC=ABS(AJAC) 
  67 : * 
  68 : *-----   MATRICE ( B ) = UJ * BKSIP 
  69 : * 
  70 :       DO I=1,3 
  71 :          DO J=1,NBN 
  72 :             B(I,J)=0. 
  73 :          END DO 
  74 :       END DO 
  75 :       DO K=1,3 
  76 :          DO J=1,3 
  77 :             DO I=1,NBN 
  78 :                B(J,I)=B(J,I)+UJ(J,K)*BKSIP(K,I) 
  79 :             END DO 
  80 :          END DO 
  81 :       END DO 
  82 : * 
  83 :       END 
  84 :  
  85 :