Numérotation des lignes :

C PB2703    SOURCE    MAGN      10/05/31    21:15:15     6679      SUBROUTINE PB2703(XREF,X,Y,Z,PG,FN,GR,FM,GM,ND,NP,MP,NG,NPG,NOM2)      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z)C************************************************************************CC     CALCULE LES FONCTIONS DE FORME D'UN : CU27C                    % etaC                   /C     ^ zetaC     |     19_______18______17C     |     /        .      / |C     |    /        .      /  |C     |  20.......26..... 16  |C     |  /       ..      /    |C     | /       . .     /     |C 1.  13______14______15      |C     |      |    .    |      |C     |     .12.....23.|......11C     |    . | D  . .  |     .|C     |   .  |    .. B |    . |C     |  24 ......27...|..22  |C     | .    |   ..    | .    |C     |.     |  . .    |.     |C     9........21......10 C   |C     |      7______6__|______5C     |     /     ..   |     /C     |    /      .    |    /C     |   8......25....|...4C     |  /      .      |  /C     | /   A  .       | /C     |/_______________|/____>ksiC     1       2       3C  0.                 1.CCCC************************************************************************      REAL*8 XREF(ND,NP),X(NPG),Y(NPG),Z(NPG)      PARAMETER (NPG1=5,NPG2=NPG1*NPG1)      REAL*8 X1(NPG1),PG1(NPG1)      REAL*8 X2(NPG2),Y2(NPG2),PG2(NPG2)      CHARACTER NOM2*4      DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)      DIMENSION F2N(9,NPG2),G2R(2,9,NPG2)      DIMENSION FM(MP,NPG),GM(ND,MP,NPG)      DIMENSION U(5),H(5),XA(3),XB(3),XC(3),XD(3),XX(3)      DIMENSION I12(27)*      SAVE XA,XB,XC,XD,I12      DATA XA/3*0.25D0/,XB/0.75D0,0.25D0,0.75D0/      DATA XC/2*0.75D0,0.25D0/,XD/0.25D0,2*0.75D0/      DATA I12/1,2,3,4,5,6,7,8,25,9,21,10,22,11,23,12,24,27,13,14,15,16,     & 17,18,19,20,26/C***      XREF(1,1)=0.D0      XREF(2,1)=0.D0      XREF(3,1)=0.D0       XREF(1,2)=0.5D0      XREF(2,2)=0.D0      XREF(3,2)=0.D0       XREF(1,3)=1.D0      XREF(2,3)=0.D0      XREF(3,3)=0.D0       XREF(1,4)=1.D0      XREF(2,4)=0.5D0      XREF(3,4)=0.D0       XREF(1,5)=1.D0      XREF(2,5)=1.D0      XREF(3,5)=0.D0       XREF(1,6)=0.5D0      XREF(2,6)=1.D0      XREF(3,6)=0.D0       XREF(1,7)=0.D0      XREF(2,7)=1.D0      XREF(3,7)=0.D0       XREF(1,8)=0.D0      XREF(2,8)=0.5D0      XREF(3,8)=0.D0       XREF(1,13)=0.D0      XREF(2,13)=0.D0      XREF(3,13)=1.D0       XREF(1,14)=0.5D0      XREF(2,14)=0.D0      XREF(3,14)=1.D0       XREF(1,15)=1.D0      XREF(2,15)=0.D0      XREF(3,15)=1.D0       XREF(1,16)=1.D0      XREF(2,16)=0.5D0      XREF(3,16)=1.D0       XREF(1,17)=1.D0      XREF(2,17)=1.D0      XREF(3,17)=1.D0       XREF(1,18)=0.5D0      XREF(2,18)=1.D0      XREF(3,18)=1.D0       XREF(1,19)=0.D0      XREF(2,19)=1.D0      XREF(3,19)=1.D0       XREF(1,20)=0.D0      XREF(2,20)=0.5D0      XREF(3,20)=1.D0       XREF(1,9)=0.D0      XREF(2,9)=0.D0      XREF(3,9)=0.5D0       XREF(1,10)=1.D0      XREF(2,10)=0.D0      XREF(3,10)=0.5D0       XREF(1,11)=1.D0      XREF(2,11)=1.D0      XREF(3,11)=0.5D0       XREF(1,12)=0.D0      XREF(2,12)=1.D0      XREF(3,12)=0.5D0       XREF(1,21)=0.5D0      XREF(2,21)=0.D0      XREF(3,21)=0.5D0       XREF(1,22)=1.D0      XREF(2,22)=0.5D0      XREF(3,22)=0.5D0       XREF(1,23)=0.5D0      XREF(2,23)=1.D0      XREF(3,23)=0.5D0       XREF(1,24)=0.D0      XREF(2,24)=0.5D0      XREF(3,24)=0.5D0       XREF(1,25)=0.5D0      XREF(2,25)=0.5D0      XREF(3,25)=0.D0       XREF(1,26)=0.5D0      XREF(2,26)=0.5D0      XREF(3,26)=1.D0       XREF(1,27)=0.5D0      XREF(2,27)=0.5D0      XREF(3,27)=0.5D0        CALL CALUHG(U,H,NG)C      NG2=NG*NG      IF(NG2.GT.25)RETURN       A=0.D0      B=1.D0      C=0.D0      D=1.D0      E=0.D0      F=1.D0      CALL CALG2(A,B,C,D,NG,H,U,X2,Y2,PG2)      CALL CALG1(E,F,NG,H,U,X1,PG1)       LL=0      DO 1 L=1,NG2      DO 2 L1=1,NG      LL=LL+1      X(L)=X2(L)      Y(L)=Y2(L)      Z(L)=X1(L1)      PG(LL)=PG1(L1)*PG2(L)C?    write(6,*)'LL=',LL,X(L),Y(L),Z(L)C      XX(1)=X(L)      XX(2)=Y(L)      XX(3)=Z(L)       IF(NOM2.EQ.'PRP0')THEN      FM(1,LL)=1.D0      CALL INITD(GM,(3*NPG),0.D0)      ELSEIF(NOM2.EQ.'PRP1')THEN      FM(1,LL)=EQPL3P(XX,XB,XC,XD)/     &        EQPL3P(XA,XB,XC,XD)      FM(2,LL)=EQPL3P(XX,XA,XC,XD)/     &        EQPL3P(XB,XA,XC,XD)      FM(3,LL)=EQPL3P(XX,XA,XB,XD)/     &        EQPL3P(XC,XA,XB,XD)      FM(4,LL)=EQPL3P(XX,XA,XB,XC)/     &        EQPL3P(XD,XA,XB,XC)      CALL INITD(GM,(12*NPG),0.D0)      ELSEIF(NOM2.EQ.'PFP1')THEN      FM(1,LL)=-(X(L)-1.D0)*(Y(L)-1.D0)*(Z(L)-1.D0)      FM(2,LL)=X(L)*(Y(L)-1.D0)*(Z(L)-1.D0)      FM(3,LL)=-X(L)*Y(L)*(Z(L)-1.D0)      FM(4,LL)=(X(L)-1.D0)*Y(L)*(Z(L)-1.D0)      FM(5,LL)=(X(L)-1.D0)*(Y(L)-1.D0)*Z(L)      FM(6,LL)=-X(L)*(Y(L)-1.D0)*Z(L)      FM(7,LL)=X(L)*Y(L)*Z(L)      FM(8,LL)=-(X(L)-1.D0)*Y(L)*Z(L)       GM(1,1,LL)=-(Y(L)-1.D0)*(Z(L)-1.D0)      GM(2,1,LL)=-(X(L)-1.D0)*(Z(L)-1.D0)      GM(3,1,LL)=-(X(L)-1.D0)*(Y(L)-1.D0)C      GM(1,2,LL)=(Y(L)-1.D0)*(Z(L)-1.D0)      GM(2,2,LL)=X(L)*(Z(L)-1.D0)      GM(3,2,LL)=X(L)*(Y(L)-1.D0)C      GM(1,3,LL)=-Y(L)*(Z(L)-1.D0)      GM(2,3,LL)=-X(L)*(Z(L)-1.D0)      GM(3,3,LL)=-X(L)*Y(L)C      GM(1,4,LL)=Y(L)*(Z(L)-1.D0)      GM(2,4,LL)=(X(L)-1.D0)*(Z(L)-1.D0)      GM(3,4,LL)=(X(L)-1.D0)*Y(L)C      GM(1,5,LL)=(Y(L)-1.D0)*Z(L)      GM(2,5,LL)=(X(L)-1.D0)*Z(L)      GM(3,5,LL)=(X(L)-1.D0)*(Y(L)-1.D0)C      GM(1,6,LL)=-(Y(L)-1.D0)*Z(L)      GM(2,6,LL)=-X(L)*Z(L)      GM(3,6,LL)=-X(L)*(Y(L)-1.D0)C      GM(1,7,LL)=Y(L)*Z(L)      GM(2,7,LL)=X(L)*Z(L)      GM(3,7,LL)=X(L)*Y(L)C      GM(1,8,LL)=-Y(L)*Z(L)      GM(2,8,LL)=-(X(L)-1.D0)*Z(L)      GM(3,8,LL)=-(X(L)-1.D0)*Y(L)C      ENDIF C      F2N(1,L)=(X(L)-1.D0)*(Y(L)-1.D0)*(2.D0*X(L)-1.D0)*(2.D0*Y(L)-1.D0)      F2N(2,L)=-4.D0*X(L)*(X(L)-1.D0)*(2.D0*Y(L)-1.D0)*(Y(L)-1.D0)      F2N(3,L)=X(L)*(2.D0*X(L)-1.D0)*(2.D0*Y(L)-1.D0)*(Y(L)-1.D0)      F2N(4,L)=-4.D0*X(L)*Y(L)*(2.D0*X(L)-1.D0)*(Y(L)-1.D0)      F2N(5,L)=X(L)*Y(L)*(2.D0*X(L)-1.D0)*(2.D0*Y(L)-1.D0)      F2N(6,L)=-4.D0*X(L)*Y(L)*(X(L)-1.D0)*(2.D0*Y(L)-1.D0)      F2N(7,L)=Y(L)*(2.D0*Y(L)-1.D0)*(2.D0*X(L)-1.D0)*(X(L)-1.D0)      F2N(8,L)=-4.D0*Y(L)*(Y(L)-1.D0)*(X(L)-1.D0)*(2.D0*X(L)-1.D0)      F2N(9,L)=16.D0*X(L)*Y(L)*(X(L)-1.D0)*(Y(L)-1.D0)C      G2R(1,1,L)=(Y(L)-1.D0)*(2.D0*Y(L)-1.D0)*(4.D0*X(L)-3.D0)      G2R(2,1,L)=(X(L)-1.D0)*(2.D0*X(L)-1.D0)*(4.D0*Y(L)-3.D0)      G2R(1,2,L)=-4.D0*(2.D0*X(L)-1.D0)*(2.D0*Y(L)-1.D0)*(Y(L)-1.D0)      G2R(2,2,L)=-4.D0*X(L)*(X(L)-1.D0)*(4.D0*Y(L)-3.D0)      G2R(1,3,L)=(2.D0*Y(L)-1.D0)*(Y(L)-1.D0)*(4.D0*X(L)-1.D0)      G2R(2,3,L)=X(L)*(2.D0*X(L)-1.D0)*(4.D0*Y(L)-3.D0)      G2R(1,4,L)=-4.D0*Y(L)*(Y(L)-1.D0)*(4.D0*X(L)-1.D0)      G2R(2,4,L)=-4.D0*X(L)*(2.D0*X(L)-1.D0)*(2.D0*Y(L)-1.D0)      G2R(1,5,L)=Y(L)*(2.D0*Y(L)-1.D0)*(4.D0*X(L)-1.D0)      G2R(2,5,L)=X(L)*(2.D0*X(L)-1.D0)*(4.D0*Y(L)-1.D0)      G2R(1,6,L)=-4.D0*Y(L)*(2.D0*Y(L)-1.D0)*(2.D0*X(L)-1.D0)      G2R(2,6,L)=-4.D0*X(L)*(X(L)-1.D0)*(4.D0*Y(L)-1.D0)      G2R(1,7,L)=Y(L)*(2.D0*Y(L)-1.D0)*(4.D0*X(L)-3.D0)      G2R(2,7,L)=(2.D0*X(L)-1.D0)*(X(L)-1.D0)*(4.D0*Y(L)-1.D0)      G2R(1,8,L)=-4.D0*Y(L)*(Y(L)-1.D0)*(4.D0*X(L)-3.D0)      G2R(2,8,L)=-4.D0*(X(L)-1.D0)*(2.D0*X(L)-1.D0)*(2.D0*Y(L)-1.D0)      G2R(1,9,L)=16.D0*Y(L)*(Y(L)-1.D0)*(2.D0*X(L)-1.D0)      G2R(2,9,L)=16.D0*X(L)*(X(L)-1.D0)*(2.D0*Y(L)-1.D0)       DO 111 I=1,9      I1=I12(I)      I9=I12(I+9)      I18=I12(I+18)      FN(I1,LL)=F2N(I,L)*(Z(L)-1.D0)*(2.D0*Z(L)-1.D0)      FN(I9,LL)=F2N(I,L)*(-4.D0)*Z(L)*(Z(L)-1.D0)      FN(I18,LL)=F2N(I,L)*Z(L)*(2.D0*Z(L)-1.D0)       GR(1,I1,LL)=G2R(1,I,L)*(Z(L)-1.D0)*(2.D0*Z(L)-1.D0)      GR(2,I1,LL)=G2R(2,I,L)*(Z(L)-1.D0)*(2.D0*Z(L)-1.D0)      GR(3,I1,LL)=F2N(I,L)*(4.D0*Z(L)-3.D0)       GR(1,I9,LL)=G2R(1,I,L)*(-4.D0)*Z(L)*(Z(L)-1.D0)      GR(2,I9,LL)=G2R(2,I,L)*(-4.D0)*Z(L)*(Z(L)-1.D0)      GR(3,I9,LL)=F2N(I,L)*(-8.D0*Z(L)+4.D0)       GR(1,I18,LL)=G2R(1,I,L)*Z(L)*(2.D0*Z(L)-1.D0)      GR(2,I18,LL)=G2R(2,I,L)*Z(L)*(2.D0*Z(L)-1.D0)      GR(3,I18,LL)=F2N(I,L)*(4.D0*Z(L)-1.D0)  111  CONTINUEC 2    CONTINUE 1    CONTINUE CC     WRITE(6,101)C     WRITE(6,*)' FM 'C     WRITE(6,1002)FMC     WRITE(6,*)' X 'C     WRITE(6,1008)XC     WRITE(6,*)' Y 'C     WRITE(6,1008)YC     WRITE(6,*)' Z 'C     WRITE(6,1008)ZC     WRITE(6,*)' GM 'C     WRITE(6,1002)GMC     WRITE(6,*)' F2N'C     WRITE(6,1002)F2N C     WRITE(6,*)' GR'C     do 8705 l=1,npgC     write(6,*)' l=',lC     WRITE(6,1002)((GR(i,j,l),i=1,nd),j=1,np)C8705 continueC     WRITE(6,101) C     write(6,*)' RET PB2703 '      RETURN 1002 FORMAT(10(1X,1PD11.4)) 1008 FORMAT( 8(1X,1PD11.4)) 1001 FORMAT(20(1X,I5)) 101  FORMAT(1X,'... SUBPB2703 ... FM,GM,F2N,GR ',9(10H..........)/)C      END

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