Sources Esope | Cast3M

elpder
C ELPDER    SOURCE    CHAT      05/01/12    23:36:25     5004
      SUBROUTINE ELPDER(XG,R,XR,XA,XB,XC,XDD,IDER,XVA)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
************************************************************************
*
*    DERIVATION D'UNE FONCTION DANS 1,2,3,4   DIRECTION FIXES
*
*       XG(1 A  5) F(R) ET SES 4 PREMIERES DERIVEES
*       XR LA DIRECTION UNITAIRE DE R
*       XA LA DIRECTION UNITAIRE DE DERIVATION 1
*       XB LA DIRECTION UNITAIRE DE DERIVATION 2
*       XC LA DIRECTION UNITAIRE DE DERIVATION 3
*       XDD LA DIRECTION UNITAIRE DE DERIVATION 4
*
*
*
*        F,AB= A.RO B.RO F21 + A.B F22
*
*
*
*        F,ABC= A.RO B.RO C.R0 F31 +( A.B C.RO + A.C B.RO + B.C A.RO) F3
*
*         AVEC F31 = V''' - 3* V'' / R + 3*V' / R**2
*              F32 =           V'' / R -   V' / R**2
*
*
*        F,ABCD= A.RO B.RO C.R0  DRO F41
*              +( AD BRO CRO  +  5 PERMUTATIONS ABCD )F42
*              +( AC BD       +  2 PERMUTATIONS ABCD )F43
*
*         AVEC F41 = V'''' - 6* V''' / R + 15*V''/ R**2-15 V' / R
*              F42 = F31 / R
*              F43 = F32 / R
*
*               RO VECTEUR  XR
************************************************************************
          DIMENSION XG (5)
          DIMENSION XR (2)
          DIMENSION XA (2)
          DIMENSION XB (2)
          DIMENSION XC (2)
          DIMENSION XDD (2)
*
       IF (IDER .EQ. 1 ) THEN
         F1 = XG(2)
         AR = XR(1)*XA(1) +XR(2)*XA(2)
         XVA = AR * F1
       ELSEIF( IDER .EQ. 2 ) THEN
         F21= XG(3) - XG(2) / R
         F22= XG(2)/R
         AR = XR(1)*XA(1) +XR(2)*XA(2)
         BR = XR(1)*XB(1) +XR(2)*XB(2)
         AB = XB(1)*XA(1) +XB(2)*XA(2)
         XVA = AR *BR* F21+ AB*F22
       ELSEIF( IDER .EQ. 3 ) THEN
         F31= XG(4) - (3 * XG(3) / R) + (3 * XG(2) / (R*R))
         F32=              XG(3) / R  - (  XG(2) / (R*R))
         AR = XR(1)*XA(1) +XR(2)*XA(2)
         BR = XR(1)*XB(1) +XR(2)*XB(2)
         CR = XR(1)*XC(1) +XR(2)*XC(2)
         AB = XA(1)*XB(1) +XA(2)*XB(2)
         AC = XA(1)*XC(1) +XA(2)*XC(2)
         BC = XB(1)*XC(1) +XB(2)*XC(2)
         XVA = (AR *BR* CR)            * F31 +
     &         (AC*BR + BC*AR + AB*CR) * F32
       ELSE
         F41= XG(5)  - (6 * XG(4) / R) + (15* XG(3) / (R*R))
     &                               - (15* XG(2) / (R*R*R))
         F31= XG(4)  - (3 * XG(3) / R) + (3 * XG(2) / (R*R))
         F42 = F31 / R
         F32=              XG(3) / R  - (  XG(2) / (R*R))
         F43 = F32 / R
 
         AR = XR(1)*XA(1) +XR(2)*XA(2)
         BR = XR(1)*XB(1) +XR(2)*XB(2)
         CR = XR(1)*XC(1) +XR(2)*XC(2)
         DR = XR(1)*XDD(1) +XR(2)*XDD(2)
 
         AB = XA(1)*XB(1) +XA(2)*XB(2)
         AC = XA(1)*XC(1) +XA(2)*XC(2)
         AD = XA(1)*XDD(1) +XA(2)*XDD(2)
         BC = XB(1)*XC(1) +XB(2)*XC(2)
         BD = XB(1)*XDD(1) +XB(2)*XDD(2)
         CD = XC(1)*XDD(1) +XC(2)*XDD(2)
*
         XVA = (AR *BR* CR * DR)                 * F41 +
     &         (AB*CR*DR + AC*BR*DR + AD*BR*CR
     &        + BC*AR*DR + BD*AR*CR + CD*AR*BR ) * F42 +
     &         (AC*BD    + BC*AD    + AB*CD    ) * F43
       ENDIF
 
       RETURN
      END