Télécharger pb442.eso

Retour à la liste

pb442
C PB442     SOURCE    CHAT      05/01/13    02:10:35     5004
      SUBROUTINE PB442(X,Y,PG,FN,GR,FM,GM,ND,NP,MP,NG,NPG,NOM2)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C************************************************************************
C
C     CALCULE LES FONCTIONS DE FORME D'UN : Iso-Q2 (P1/P0)
C
C     ^ eta
C     |
C   1 n7_____n6_______ n5
C     |       |       |
C     | x   x | x   x |
C     | x 4 x | x 3 x |
C  1/2|_______|_______|n4
C     |n8     |n9     |
C     | x   x | x   x |
C     | x 1 x | x 2 x |
C     |_______|_______|______>ksi
C     0       1/2    1
C     n1      n2     n3
C************************************************************************
 
      REAL*8 X(NPG),Y(NPG)
      REAL*8 FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
      REAL*8 FM(MP,NPG),GM(ND,MP,NPG)
      REAL*8 A,B,C,D,U(6),H(6)
      CHARACTER*4 NOM2
C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
C     NPG=16 !!!  NG=2 !!!
C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 
      CALL CALUHG(U,H,NG)
 
C OMEGA 1
 
      A=0.D0
      B=0.5D0
      C=0.D0
      D=0.5D0
      CALL CALG2(A,B,C,D,NG,H,U,X,Y,PG)
 
      DO 1 L=1,4
C
      FN(1,L)=(1.D0-2.D0*X(L))*(1.D0-2.D0*Y(L))
      GR(1,1,L)=-2.D0*(1.D0-2.D0*Y(L))
      GR(2,1,L)=-2.D0*(1.D0-2.D0*X(L))
 
      FN(2,L)=2.D0*X(L)*(1.D0-2.D0*Y(L))
      GR(1,2,L)=2.D0*(1.D0-2.D0*Y(L))
      GR(2,2,L)=-4.D0*X(L)
 
      FN(3,L)=0.D0
      GR(1,3,L)=0.D0
      GR(2,3,L)=0.D0
 
      FN(4,L)=0.D0
      GR(1,4,L)=0.D0
      GR(2,4,L)=0.D0
 
      FN(5,L)=0.D0
      GR(1,5,L)=0.D0
      GR(2,5,L)=0.D0
 
      FN(6,L)=0.D0
      GR(1,6,L)=0.D0
      GR(2,6,L)=0.D0
 
      FN(7,L)=0.D0
      GR(1,7,L)=0.D0
      GR(2,7,L)=0.D0
 
      FN(8,L)=2.D0*Y(L)*(1.D0-2.D0*X(L))
      GR(1,8,L)=-4.D0*Y(L)
      GR(2,8,L)=2.D0*(1.D0-2.D0*X(L))
 
      FN(9,L)=4.D0*X(L)*Y(L)
      GR(1,9,L)=4.D0*Y(L)
      GR(2,9,L)=4.D0*X(L)
 
C
      IF(NOM2.EQ.'MCP0')THEN
      FM(1,L)=1.D0
      GM(1,1,L)=0.D0
      GM(2,1,L)=0.D0
      ELSEIF(NOM2.EQ.'MCP1')THEN
      FM(1,L)= 1.D0/3.D0*(4.D0*X(L)+4.D0*Y(L)-3.D0)
      FM(2,L)=-1.D0/3.D0*(8.D0*X(L)-4.D0*Y(L)-3.D0)
      FM(3,L)= 1.D0/3.D0*(4.D0*X(L)-8.D0*Y(L)+3.D0)
      ELSEIF(NOM2.EQ.'MCF1')THEN
      FM(1,L)= (X(L)-1.D0)*(Y(L)-1.D0)
      FM(2,L)=-X(L)*(Y(L)-1.D0)
      FM(3,L)= X(L)*Y(L)
      FM(4,L)=-Y(L)*(X(L)-1.D0)
 
      GM(1,1,L)=Y(L)-1.D0
      GM(2,1,L)=X(L)-1.D0
      GM(1,2,L)=-(Y(L)-1.D0)
      GM(2,2,L)=-X(L)
      GM(1,3,L)=Y(L)
      GM(2,3,L)=X(L)
      GM(1,4,L)=-Y(L)
      GM(2,4,L)=-(X(L)-1.D0)
      ENDIF
 
 1    CONTINUE
 
C OMEGA 2
 
      A=0.5D0
      B=1.D0
      C=0.D0
      D=0.5D0
      CALL CALG2(A,B,C,D,NG,H,U,X(5),Y(5),PG(5))
 
      DO 2 L=5,8
C
      FN(1,L)=0.D0
      GR(1,1,L)=0.D0
      GR(2,1,L)=0.D0
 
      FN(2,L)=2.D0*(1.D0-X(L))*(1.D0-2.D0*Y(L))
      GR(1,2,L)=-2.D0*(1.D0-2.D0*Y(L))
      GR(2,2,L)=-4.D0*(1.D0-X(L))
 
      FN(3,L)=-(1.D0-2.D0*X(L))*(1.D0-2.D0*Y(L))
      GR(1,3,L)=2.D0*(1.D0-2.D0*Y(L))
      GR(2,3,L)=2.D0*(1.D0-2.D0*X(L))
 
      FN(4,L)=-2.D0*Y(L)*(1.D0-2.D0*X(L))
      GR(1,4,L)=4.D0*Y(L)
      GR(2,4,L)=-2.D0*(1.D0-2.D0*X(L))
 
      FN(5,L)=0.D0
      GR(1,5,L)=0.D0
      GR(2,5,L)=0.D0
 
      FN(6,L)=0.D0
      GR(1,6,L)=0.D0
      GR(2,6,L)=0.D0
 
      FN(7,L)=0.D0
      GR(1,7,L)=0.D0
      GR(2,7,L)=0.D0
 
      FN(8,L)=0.D0
      GR(1,8,L)=0.D0
      GR(2,8,L)=0.D0
 
      FN(9,L)=4.D0*(1.D0-X(L))*Y(L)
      GR(1,9,L)=-4.D0*Y(L)
      GR(2,9,L)=4.D0*(1.D0-X(L))
 
C
      IF(NOM2.EQ.'MCP0')THEN
      FM(1,L)=1.D0
      GM(1,1,L)=0.D0
      GM(2,1,L)=0.D0
      ELSEIF(NOM2.EQ.'MCP1')THEN
      FM(1,L)= 1.D0/3.D0*(4.D0*X(L)+4.D0*Y(L)-3.D0)
      FM(2,L)=-1.D0/3.D0*(8.D0*X(L)-4.D0*Y(L)-3.D0)
      FM(3,L)= 1.D0/3.D0*(4.D0*X(L)-8.D0*Y(L)+3.D0)
      ELSEIF(NOM2.EQ.'MCF1')THEN
      FM(1,L)= (X(L)-1.D0)*(Y(L)-1.D0)
      FM(2,L)=-X(L)*(Y(L)-1.D0)
      FM(3,L)= X(L)*Y(L)
      FM(4,L)=-Y(L)*(X(L)-1.D0)
 
      GM(1,1,L)=Y(L)-1.D0
      GM(2,1,L)=X(L)-1.D0
      GM(1,2,L)=-(Y(L)-1.D0)
      GM(2,2,L)=-X(L)
      GM(1,3,L)=Y(L)
      GM(2,3,L)=X(L)
      GM(1,4,L)=-Y(L)
      GM(2,4,L)=-(X(L)-1.D0)
      ENDIF
 
 2    CONTINUE
 
C OMEGA 3
 
      A=0.5D0
      B=1.D0
      C=0.5D0
      D=1.D0
      CALL CALG2(A,B,C,D,NG,H,U,X(9),Y(9),PG(9))
 
      DO 3 L=9,12
C
      FN(1,L)=0.D0
      GR(1,1,L)=0.D0
      GR(2,1,L)=0.D0
 
      FN(2,L)=0.D0
      GR(1,2,L)=0.D0
      GR(2,2,L)=0.D0
 
      FN(3,L)=0.D0
      GR(1,3,L)=0.D0
      GR(2,3,L)=0.D0
 
      FN(4,L)=-2.D0*(1.D0-2.D0*X(L))*(1.D0-Y(L))
      GR(1,4,L)=4.D0*(1.D0-Y(L))
      GR(2,4,L)=2.D0*(1.D0-2.D0*X(L))
 
      FN(5,L)=(1.D0-2.D0*X(L))*(1.D0-2.D0*Y(L))
      GR(1,5,L)=-2.D0*(1.D0-2.D0*Y(L))
      GR(2,5,L)=-2.D0*(1.D0-2.D0*X(L))
 
      FN(6,L)=-2.D0*(1.D0-2.D0*Y(L))*(1.D0-X(L))
      GR(1,6,L)=2.D0*(1.D0-2.D0*Y(L))
      GR(2,6,L)=4.D0*(1.D0-X(L))
 
      FN(7,L)=0.D0
      GR(1,7,L)=0.D0
      GR(2,7,L)=0.D0
 
      FN(8,L)=0.D0
      GR(1,8,L)=0.D0
      GR(2,8,L)=0.D0
 
      FN(9,L)=4.D0*(1.D0-X(L))*(1.D0-Y(L))
      GR(1,9,L)=-4.D0*(1.D0-Y(L))
      GR(2,9,L)=-4.D0*(1.D0-X(L))
 
C
      IF(NOM2.EQ.'MCP0')THEN
      FM(1,L)=1.D0
      GM(1,1,L)=0.D0
      GM(2,1,L)=0.D0
      ELSEIF(NOM2.EQ.'MCP1')THEN
      FM(1,L)= 1.D0/3.D0*(4.D0*X(L)+4.D0*Y(L)-3.D0)
      FM(2,L)=-1.D0/3.D0*(8.D0*X(L)-4.D0*Y(L)-3.D0)
      FM(3,L)= 1.D0/3.D0*(4.D0*X(L)-8.D0*Y(L)+3.D0)
      ELSEIF(NOM2.EQ.'MCF1')THEN
      FM(1,L)= (X(L)-1.D0)*(Y(L)-1.D0)
      FM(2,L)=-X(L)*(Y(L)-1.D0)
      FM(3,L)= X(L)*Y(L)
      FM(4,L)=-Y(L)*(X(L)-1.D0)
 
      GM(1,1,L)=Y(L)-1.D0
      GM(2,1,L)=X(L)-1.D0
      GM(1,2,L)=-(Y(L)-1.D0)
      GM(2,2,L)=-X(L)
      GM(1,3,L)=Y(L)
      GM(2,3,L)=X(L)
      GM(1,4,L)=-Y(L)
      GM(2,4,L)=-(X(L)-1.D0)
      ENDIF
 
 3    CONTINUE
 
C OMEGA 4
 
      A=0.D0
      B=0.5D0
      C=0.5D0
      D=1.D0
      CALL CALG2(A,B,C,D,NG,H,U,X(13),Y(13),PG(13))
 
      DO 4 L=13,16
C
      FN(1,L)=0.D0
      GR(1,1,L)=0.D0
      GR(2,1,L)=0.D0
 
      FN(2,L)=0.D0
      GR(1,2,L)=0.D0
      GR(2,2,L)=0.D0
 
      FN(3,L)=0.D0
      GR(1,3,L)=0.D0
      GR(2,3,L)=0.D0
 
      FN(4,L)=0.D0
      GR(1,4,L)=0.D0
      GR(2,4,L)=0.D0
 
      FN(5,L)=0.D0
      GR(1,5,L)=0.D0
      GR(2,5,L)=0.D0
 
      FN(6,L)=-2.D0*X(L)*(1.D0-2.D0*Y(L))
      GR(1,6,L)=-2.D0*(1.D0-2.D0*Y(L))
      GR(2,6,L)=4.D0*X(L)
 
      FN(7,L)=-(1.D0-2.D0*Y(L))*(1.D0-2.D0*X(L))
      GR(1,7,L)=2.D0*(1.D0-2.D0*Y(L))
      GR(2,7,L)=2.D0*(1.D0-2.D0*X(L))
 
      FN(8,L)=2.D0*(1.D0-2.D0*X(L))*(1.D0-Y(L))
      GR(1,8,L)=-4.D0*(1.D0-Y(L))
      GR(2,8,L)=-2.D0*(1.D0-2.D0*X(L))
 
      FN(9,L)=4.D0*X(L)*(1.D0-Y(L))
      GR(1,9,L)=4.D0*(1.D0-Y(L))
      GR(2,9,L)=-4.D0*X(L)
 
C
      IF(NOM2.EQ.'MCP0')THEN
      FM(1,L)=1.D0
      GM(1,1,L)=0.D0
      GM(2,1,L)=0.D0
      ELSEIF(NOM2.EQ.'MCP1')THEN
      FM(1,L)= 1.D0/3.D0*(4.D0*X(L)+4.D0*Y(L)-3.D0)
      FM(2,L)=-1.D0/3.D0*(8.D0*X(L)-4.D0*Y(L)-3.D0)
      FM(3,L)= 1.D0/3.D0*(4.D0*X(L)-8.D0*Y(L)+3.D0)
      ELSEIF(NOM2.EQ.'MCF1')THEN
      FM(1,L)= (X(L)-1.D0)*(Y(L)-1.D0)
      FM(2,L)=-X(L)*(Y(L)-1.D0)
      FM(3,L)= X(L)*Y(L)
      FM(4,L)=-Y(L)*(X(L)-1.D0)
 
      GM(1,1,L)=Y(L)-1.D0
      GM(2,1,L)=X(L)-1.D0
      GM(1,2,L)=-(Y(L)-1.D0)
      GM(2,2,L)=-X(L)
      GM(1,3,L)=Y(L)
      GM(2,3,L)=X(L)
      GM(1,4,L)=-Y(L)
      GM(2,4,L)=-(X(L)-1.D0)
      ENDIF
 
 4    CONTINUE
 
C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
C     WRITE(6,*)'X'
C     WRITE(6,1002)X
C     WRITE(6,*)'Y'
C     WRITE(6,1002)Y
C     WRITE(6,*)'FN'
C     do 1782 l=1,4
C     WRITE(6,1002)FN(1,L),FN(2,L+4),FN(9,L+8),FN(8,L+12)
C     WRITE(6,1002)FN(2,L),FN(3,L+4),FN(4,L+8),FN(9,L+12)
C     WRITE(6,1002)FN(9,L),FN(4,L+4),FN(5,L+8),FN(6,L+12)
C     WRITE(6,1002)FN(8,L),FN(9,L+4),FN(6,L+8),FN(7,L+12)
C1782 continue
C     WRITE(6,*)'GM'
C     WRITE(6,1002)GM
C     WRITE(6,*)'FM'
C     WRITE(6,1002)FM
 
      RETURN
 1002 FORMAT(10(1X,1PE11.4))
 1001 FORMAT(20(1X,I5))
C
      END
 
 
 
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales