Esope source files

   1 : C ASSKP2    SOURCE    CHAT      07/10/22    21:15:11     5921           
   2 :       SUBROUTINE ASSKP2(IFACE,BKP,XN,tKP)
   3 :       IMPLICIT REAL*8(A-H,O-Z)
   4 :       IMPLICIT INTEGER (I-N)
   5 : 
   6 : 
   7 : C ASSEMBLAGE DE KP POUR LE SHB8
   8 : *      REAL *8 BKP(3,4),XN(3),tkp(24,24),XKP(24),YKP(24),ZKP(24),B(3,8)
   9 : *      REAL *8 KPTMP(24,24)
  10 : *      INTEGER I,J,IFACE
  11 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  12 : 
  13 :       DIMENSION BKP(3,4),XN(3),tkp(24,24),XKP(24),YKP(24),ZKP(24),B(3,8)
  14 :       dimension tkptmp(24,24)
  15 :       IF(IFACE.NE.1.AND.IFACE.NE.2) THEN
  16 :          WRITE(6,*)'******** FACE NON DEFINIE DANS ASSE_KP2 *******'
  16 :          CALL ERREUR(5)
  17 :          STOP
  18 :       ENDIF
  19 :       DO I=1,3
  20 :          DO J=1,8
  21 :             B(I,J)=0.
  22 :          ENDDO
  23 :       ENDDO
  24 :       IF(IFACE.EQ.1)THEN
  25 : CCCCCCCCCCCCCCC PRESSION SUR FACE INFERIEURE      
  26 :          DO I=1,3
  27 :             DO J=1,4
  28 :                B(I,J)=BKP(I,J)
  29 :             ENDDO
  30 :          ENDDO
  31 :       ENDIF
  32 :       IF(IFACE.EQ.2)THEN
  33 : CCCCCCCCCCCCCCC PRESSION SUR FACE SUPERIEURE      
  34 :          DO I=1,3
  35 :             DO J=5,8
  36 :                B(I,J)=BKP(I,J-4)
  37 :             ENDDO
  38 :          ENDDO
  39 :       ENDIF
  40 :       DO I=1,24
  41 :          XKP(I)=0.
  42 :          YKP(I)=0.
  43 :          ZKP(I)=0.
  44 :       ENDDO
  45 :       DO I=9,16
  46 :          XKP(I)=B(2,I-8)*XN(1)-B(1,I-8)*XN(2)
  47 :       ENDDO
  48 :       DO I=17,24
  49 :          XKP(I)=B(3,I-16)*XN(1)-B(1,I-16)*XN(3)
  50 :       ENDDO
  51 :       DO I=1,8
  52 :          YKP(I)=B(1,I)*XN(2)-B(2,I)*XN(1)
  53 :       ENDDO
  54 :       DO I=17,24
  55 :          YKP(I)=B(3,I-16)*XN(2)-B(2,I-16)*XN(3)
  56 :       ENDDO
  57 :       DO I=1,8
  58 :          ZKP(I)=B(1,I)*XN(3)-B(3,I)*XN(1)
  59 :       ENDDO
  60 :       DO I=9,16
  61 :          ZKP(I)=B(2,I-8)*XN(3)-B(3,I-8)*XN(2)
  62 :       ENDDO
  63 :       DO I=1,24
  64 :          DO J=1,24
  65 :             tkptmp(J,I)=0.
  66 :          ENDDO
  67 :       ENDDO
  68 :       DO I=1,24
  69 :          DO J=1,8
  70 :             tkptmp(J,I)=XKP(I)
  71 :          ENDDO
  72 :          DO J=9,16
  73 :             tkptmp(J,I)=YKP(I)
  74 :          ENDDO
  75 :          DO J=17,24
  76 :             tkptmp(J,I)=ZKP(I)
  77 :          ENDDO
  78 :       ENDDO
  79 :       DO I=1,24
  80 :          DO J=1,24
  81 :             tkp(I,J)=(tkptmp(I,J)+tkptmp(J,I))/2.
  82 : C            KP(I,J)=KPTMP(I,J)
  83 :          ENDDO
  84 :       ENDDO
  85 :       RETURN
  86 :       END
  87 : 
  88 :