Esope source files

   1 : C CUBEIT    SOURCE    CHAT      05/01/12    22:32:27     5004           
   2 :       SUBROUTINE CUBEIT(ICM,XE,XEC,XX,SHPC,SGA,QSI,IG)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT  REAL*8(A-H,O-Z)  
   5 :       DIMENSION A(3,8),AJ(3,3),X(3),XE(3,*),XEC(3,2),XX(3,2),
   6 :      & BJ(3,3),F(3),SHPC(6,20,*),SGA(3,5,5),QSI(3,2),DT(3),SIB(3)
   7 :       DATA EPSI/1.D-7/
   8 : C --- IG: NUMERO DU POINT DE GAUSS
   9 :       DO 10 I=1,3
  10 :       S11=XE(I,1)+XE(I,2)
  11 :       S22=XE(I,1)-XE(I,2)
  12 :       T11=XE(I,3)+XE(I,4)
  13 :       T22=XE(I,3)-XE(I,4)
  14 :       U11=XE(I,5)+XE(I,6)
  15 :       U22=XE(I,5)-XE(I,6)
  16 :       V11=XE(I,7)+XE(I,8)
  17 :       V22=XE(I,7)-XE(I,8)
  18 :       A(I,1)= S11+T11+U11+V11-8.D0*XX(I,IG)
  19 :       A(I,2)=-S22+T22-U22+V22
  20 :       A(I,3)=-S11+T11-U11+V11
  21 :       A(I,4)=-S11-T11+U11+V11
  22 :       A(I,5)= S22+T22+U22+V22
  23 :       A(I,6)= S11-T11-U11+V11
  24 :       A(I,7)= S22-T22-U22+V22
  25 :   10  A(I,8)=-S22-T22+U22+V22
  26 : C --- Initialisation  
  27 :       DO 15 I=1,3
  28 :   15  X(I)=0.0
  29 : C
  30 :       ITER=0
  31 :       ICRI=0
  32 :  100  CONTINUE
  33 : C --- LES DERIVEES DES FONCTIONS DE TRANSFORMATION
  34 :       X12=X(1)*X(2)
  35 :       X23=X(2)*X(3)
  36 :       X31=X(3)*X(1)
  37 :       DO 20 I=1,3
  38 :       AJ(I,1)=A(I,2)+A(I,5)*X(2)+A(I,7)*X(3)+A(I,8)*X23
  39 :       AJ(I,2)=A(I,3)+A(I,5)*X(1)+A(I,6)*X(3)+A(I,8)*X31
  40 :   20  AJ(I,3)=A(I,4)+A(I,6)*X(2)+A(I,7)*X(1)+A(I,8)*X12
  41 : C --- Calcul de l'inverse de la matrice AJ et son determinant :BJ=inverse(AJ)
  41 :       CALL INVERT(AJ,BJ,DET,ICRI)
  42 :       DO 40 I=1,3
  43 :   40  F(I)=A(I,1)+A(I,2)*X(1)+A(I,3)*X(2)+A(I,4)*X(3)+A(I,5)*X12
  44 :      &    +A(I,6)*X23+A(I,7)*X31+A(I,8)*X(1)*X23
  45 :       DD=SQRT(F(1)*F(1)+F(2)*F(2)+F(3)*F(3))
  46 :       IF(DD.GT.EPSI) THEN
  47 :       ITER=ITER+1
  48 :       DO 50 I=1,3
  49 :   50  X(I)=X(I)-BJ(I,1)*F(1)-BJ(I,2)*F(2)-BJ(I,3)*F(3)
  50 :       GOTO 100
  51 :       END IF
  52 :       DO 60 I=1,3
  53 :   60  QSI(I,IG)=X(I)
  54 :       C=0.125D0
  55 :       A1=1.D0+X(1)
  56 :       A2=1.D0-X(1)
  57 :       B1=1.D0+X(2)
  58 :       B2=1.D0-X(2)
  59 :       C1=1.D0+X(3)
  60 :       C2=1.D0-X(3)
  61 : C --- Calcul des fonctions d'interpolation leur derivees
  62 : C --- Derivee de Ni par rapport a QSI
  63 :       SHPC(2,1,IG)=-B2*C2*C
  64 :       SHPC(2,2,IG)=-SHPC(2,1,IG)
  65 :       SHPC(2,3,IG)= B1*C2*C
  66 :       SHPC(2,4,IG)=-SHPC(2,3,IG)
  67 :       SHPC(2,5,IG)=-B2*C1*C
  68 :       SHPC(2,6,IG)=-SHPC(2,5,IG)
  69 :       SHPC(2,7,IG)= B1*C1*C
  70 :       SHPC(2,8,IG)=-SHPC(2,7,IG)
  71 :       IF(ICM.NE.0) THEN
  72 : C --- Derivee de Ni par rapport a ETA
  73 :       SHPC(3,1,IG)=-A2*C2*C
  74 :       SHPC(3,2,IG)=-A1*C2*C
  75 :       SHPC(3,3,IG)=-SHPC(3,2,IG)
  76 :       SHPC(3,4,IG)=-SHPC(3,1,IG)
  77 :       SHPC(3,5,IG)=-A2*C1*C
  78 :       SHPC(3,6,IG)=-A1*C1*C
  79 :       SHPC(3,7,IG)=-SHPC(3,6,IG)
  80 :       SHPC(3,8,IG)=-SHPC(3,5,IG)
  81 : C --- Derivee de Ni par rapport a DZE
  82 :       SHPC(4,1,IG)=-A2*B2*C
  83 :       SHPC(4,2,IG)=-A1*B2*C
  84 :       SHPC(4,3,IG)=-A1*B1*C
  85 :       SHPC(4,4,IG)=-A2*B1*C
  86 :       SHPC(4,5,IG)=-SHPC(4,1,IG)
  87 :       SHPC(4,6,IG)=-SHPC(4,2,IG)
  88 :       SHPC(4,7,IG)=-SHPC(4,3,IG)
  89 :       SHPC(4,8,IG)=-SHPC(4,4,IG)
  90 :       END IF
  91 : C --- Fonctions d'interpolation Ni
  92 :       SHPC(1,1,IG)=-A2*SHPC(2,1,IG)
  93 :       SHPC(1,2,IG)= A1*SHPC(2,2,IG)
  94 :       SHPC(1,3,IG)= A1*SHPC(2,3,IG)
  95 :       SHPC(1,4,IG)=-A2*SHPC(2,4,IG)
  96 :       SHPC(1,5,IG)=-A2*SHPC(2,5,IG)
  97 :       SHPC(1,6,IG)= A1*SHPC(2,6,IG)
  98 :       SHPC(1,7,IG)= A1*SHPC(2,7,IG)
  99 :       SHPC(1,8,IG)=-A2*SHPC(2,8,IG)
  99 :       CALL PROSGA(ICM,XE,XEC,XX,X,SHPC,SGA,QSI,IG,8)
 100 :       END
 101 :       
 102 :       
 103 : 
 104 :  
 105 :