Sources Esope | Cast3M

derqp2
C DERQP2    SOURCE    CHAT      05/01/12    22:43:10     5004
      SUBROUTINE DERQP2(P, IVAR, DP)
C
C     Procedure de multiplication de 2 polynomes de 2 variables
C     Entree : P(30) : premier polynome : les coefficients sont
C                       ranges comme suit :
C               indice : 1 2  3    4    5    6      7       8    9
C               terme :  1 T1 T2 T1*T2 T1^2 T2^2 T1*T2^2 T1^2*T2 T1^3
C               indice : 10   11      12        13        14   15
C               terme :  T2^3 T1*T2^3 T1^2*T2^2 T1^3*T2^3 T1^4 T2^4
C               indice : 16      17        18        19      20   21
C               terme :  T1*T2^4 T1^2*T2^3 T1^3*T2^2 T1^4*T2 T1^5 T2^5
C               indice : 22      23        24        25        26
C               terme :  T1*T2^5 T1^2*T2^4 T1^3*T2^3 T1^4*T2^2 T1^5*T2
C               indice : 27        28        29        30
C               terme :  T1^2*T2^5 T1^3*T2^4 T1^4*T2^3 T1^5*T2^2
C              IVAR : numero de la variable par rapport a laquelle il
C                       faut deriver
C     Sortie : DP(30) : polynome resultat de la derivation
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION P(30), DP(30), INXD1(30), INXD2(30), C1(30), C2(30)
      DATA INXD1/ 1, 1, 1, 3, 2, 1, 6, 4, 5, 1, 10, 7, 8, 9, 1, 1,
     1        11, 12, 13, 14, 1, 21, 16, 17, 18, 19, 22, 23, 24, 25/
      DATA C1/0.D0, 1.D0, 0.D0, 1.D0, 2.D0, 0.D0, 1.D0, 2.D0, 3.D0,
     1        0.D0, 1.D0, 2.D0, 3.D0, 4.D0,
     1        0.D0, 1.D0, 2.D0, 3.D0, 4.D0, 5.D0, 0.D0, 1.D0, 2.D0,
     1        3.D0, 4.D0, 5.D0, 2.D0, 3.D0, 4.D0, 5.D0/
      DATA INXD2/ 1, 1, 1, 2, 1, 3, 4, 5, 1, 6, 7, 8, 9, 1, 10, 11,
     1        12, 13, 14, 1, 15, 16, 17, 18, 19, 20, 23, 24, 25, 26/
      DATA C2/0.D0, 0.D0, 1.D0, 1.D0, 0.D0, 2.D0, 2.D0, 1.D0, 0.D0,
     1        3.D0, 3.D0, 2.D0, 1.D0, 0.D0,
     1        4.D0, 4.D0, 3.D0, 2.D0, 1.D0, 0.D0, 5.D0, 5.D0, 4.D0,
     1        3.D0, 2.D0, 1.D0, 5.D0, 4.D0, 3.D0, 2.D0/
C
C     Initialisation du polynome resultat
C
      DO 70 I = 1, 30
  70     DP(I) = 0.D0
C
C     Derivation de P
C
      IF (IVAR .EQ. 1) THEN
         DO 80 I = 2, 30
  80        DP(INXD1(I)) = DP(INXD1(I)) + C1(I)*P(I)
      ELSE
         IF (IVAR .EQ. 2) THEN
            DO 90 I = 2, 30
  90           DP(INXD2(I)) = DP(INXD2(I)) + C2(I)*P(I)
         ENDIF
      ENDIF
      RETURN
      END