Esope source files

   1 : C PRISIX    SOURCE    CHAT      05/01/13    02:27:44     5004           
   2 :       SUBROUTINE PRISIX(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,6),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 :       A(I,1)= XE(I,1)+XE(I,4)-2.D0*XX(I,IG)
  11 :       A(I,2)=-XE(I,1)+XE(I,2)-XE(I,4)+XE(I,5)
  12 :       A(I,3)=-XE(I,1)+XE(I,3)-XE(I,4)+XE(I,6)
  13 :       A(I,4)=-XE(I,1)+XE(I,4)
  14 :       A(I,5)= XE(I,1)-XE(I,2)-XE(I,4)+XE(I,5)
  15 :   10  A(I,6)= XE(I,1)-XE(I,3)-XE(I,4)+XE(I,6)
  16 : C --- Initialisation
  17 :       DO 15 I=1,3
  18 :   15  X(I)=0.0
  19 : C
  20 :       ITER=0
  21 :       ICRI=0
  22 :  100  CONTINUE
  23 : C --- LES DERIVEES DES FONCTIONS DE TRANSFORMATION
  24 :       DO 20 I=1,3
  25 :       AJ(I,1)=A(I,2)+A(I,5)*X(3)
  26 :       AJ(I,2)=A(I,3)+A(I,6)*X(3)
  27 :   20  AJ(I,3)=A(I,4)+A(I,5)*X(1)+A(I,6)*X(2)
  28 : C --- Calcul de l'inverse de la matrice AJ et son determinant :BJ=inverse(AJ)
  28 :       CALL INVERT(AJ,BJ,DET,ICRI)
  29 :       X13=X(1)*X(3)
  30 :       X23=X(2)*X(3)
  31 :       DO 40 I=1,3
  32 :   40  F(I)=A(I,1)+A(I,2)*X(1)+A(I,3)*X(2)+A(I,4)*X(3)+A(I,5)*X13
  33 :      &    +A(I,6)*X23
  34 :       DD=SQRT(F(1)*F(1)+F(2)*F(2)+F(3)*F(3))
  35 :       IF(DD.GT.EPSI) THEN
  36 :       ITER=ITER+1
  37 :       DO 50 I=1,3
  38 :   50  X(I)=X(I)-BJ(I,1)*F(1)-BJ(I,2)*F(2)-BJ(I,3)*F(3)
  39 :       GOTO 100
  40 :       END IF
  41 :       DO 60 I=1,3
  42 :   60  QSI(I,IG)=X(I)
  43 :       DLAMD=1.D0-X(1)-X(2)
  44 :       AA=0.5D0-0.5D0*X(3)
  45 :       BB=0.5D0+0.5D0*X(3)
  46 : C --- Calcul des fonctions d'interpolation et leur derivees
  47 : C --- Fonctions d'interpolation Ni
  48 :       SHPC(1,1,IG)=DLAMD*AA
  49 :       SHPC(1,2,IG)= X(1)*AA
  50 :       SHPC(1,3,IG)= X(2)*AA
  51 :       SHPC(1,4,IG)=DLAMD*BB
  52 :       SHPC(1,5,IG)= X(1)*BB
  53 :       SHPC(1,6,IG)= X(2)*BB
  54 :       IF(ICM.NE.0) THEN
  55 : C --- Derivee de Ni par rapport a QSI
  56 :       SHPC(2,1,IG)=-AA
  57 :       SHPC(2,2,IG)= AA
  58 :       SHPC(2,3,IG)=0.D0
  59 :       SHPC(2,4,IG)=-BB
  60 :       SHPC(2,5,IG)= BB
  61 :       SHPC(2,6,IG)=0.D0
  62 : C --- Derivee de Ni par rapport a ETA
  63 :       SHPC(3,1,IG)=-AA
  64 :       SHPC(3,2,IG)=0.D0
  65 :       SHPC(3,3,IG)= AA
  66 :       SHPC(3,4,IG)=-BB
  67 :       SHPC(3,5,IG)=0.D0
  68 :       SHPC(3,6,IG)= BB
  69 : C --- Derivee de Ni par rapport a DZE
  70 :       SHPC(4,1,IG)=-0.5D0*DLAMD
  71 :       SHPC(4,2,IG)=-0.5D0*X(1)
  72 :       SHPC(4,3,IG)=-0.5D0*X(2)
  73 :       SHPC(4,4,IG)= 0.5D0*DLAMD
  74 :       SHPC(4,5,IG)= 0.5D0*X(1)
  75 :       SHPC(4,6,IG)= 0.5D0*X(2)
  76 :       END IF
  76 :       CALL PROSGA(ICM,XE,XEC,XX,X,SHPC,SGA,QSI,IG,6)
  77 :       END
  78 : 
  79 : 
  80 : 
  81 : 
  82 :  
  83 :