Sat Jun 29 14:08:44 PDT 1991
REDUCE 3.4, 15-Jul-91 ...

1: 1: 
2: 2: 
*** ^ redefined 

3: 3: %Problem: Calculate the PDE's for the isovector of the heat equation.
%--------
%         (c.f. B.K. Harrison, f.B. Estabrook, "Geometric Approach...",
%          J. Math. Phys. 12, 653, 1971);

%The heat equation @   psi = @  psi is equivalent to the set of exterior
%                   xx        t

%equations (with u=@ psi, y=@ psi):
%                   T        x


pform psi=0,u=0,x=0,y=0,t=0,a=1,da=2,b=2;



a:=d psi - u*d t - y*d x;


A :=  - d T*U - d X*Y + d PSI


da:=- d u^d t - d y^d x;


DA := d T^d U + d X^d Y


b:=u*d x^d t - d y^d t;


B :=  - d T^d X*U + d T^d Y



%Now calculate the PDE's for the isovector;

tvector v;



pform vpsi=0,vt=0,vu=0,vx=0,vy=0;


fdomain vpsi=vpsi(psi,t,u,x,y),vt=vt(psi,t,u,x,y),vu=vu(psi,t,u,x,y),
                               vx=vx(psi,t,u,x,y),vy=vy(psi,t,u,x,y);



v:=vpsi*@ psi + vt*@ t + vu*@ u + vx*@ x + vy*@ y;


V := @ *VT + @ *VU + @ *VX + @ *VY + @   *VPSI
      T       U       X       Y       PSI



factor d;


on rat;



i1:=v |_ a - l*a;


I1 := d T*(@ VPSI - @ VT*U - @ VX*Y + L*U - VU)
            T        T        T

       + d U*(@ VPSI - @ VT*U - @ VX*Y)
               U        U        U

       + d X*(@ VPSI - @ VT*U - @ VX*Y + L*Y - VY)
               X        X        X

       + d Y*(@ VPSI - @ VT*U - @ VX*Y)
               Y        Y        Y

       + d PSI*(@   VPSI - @   VT*U - @   VX*Y - L)
                 PSI        PSI        PSI


pform o=1;



o:=ot*d t + ox*d x + ou*d u + oy*d y;


O := d T*OT + d U*OU + d X*OX + d Y*OY


fdomain f=f(psi,t,u,x,y);



i11:=v _|d a - l*a + d f;


I11 := d T*(L*U - VU) + d U*VT + d X*(L*Y - VY) + d Y*VX - d PSI*L


let vx=-@(f,y),vt=-@(f,u),vu=@(f,t)+u*@(f,psi),vy=@(f,x)+y*@(f,psi),
    vpsi=f-u*@(f,u)-y*@(f,y);



factor ^;



i2:=v |_ b - xi*b - o^a + zet*da;


I2 := d T^d U*(@   F + @   F*U + @     F*Y - U*OU + ZET) + d T^d X*(
                U X     U Y       U PSI

         @   F*U - @ F + @   F + @   F*U + @     F*Y - @   F*U - U*OX
          T U       T     X X     X Y       X PSI       PSI

          + U*XI + Y*OT) + d T^d Y

      *( - @   F + @   F + @   F*U + @     F*Y + @   F - U*OY - XI)
            T U     X Y     Y Y       Y PSI       PSI

       + d T^d PSI*(@     F + @     F*U + @       F*Y - OT)
                     X PSI     Y PSI       PSI PSI

       + d U^d X*(@   F*U + Y*OU) - d U^d Y*@   F - d U^d PSI*OU
                   U U                       U U

       + d X^d Y*( - @   F - @   F*U - Y*OY + ZET)
                      U X     U Y

       - d X^d PSI*(@     F*U + OX) + d Y^d PSI*(@     F - OY)
                     U PSI                        U PSI


let ou=0,oy=@(f,u,psi),ox=-u*@(f,u,psi),
    ot=@(f,x,psi)+u*@(f,y,psi)+y*@(f,psi,psi);



i2;


d T^d U*(@   F + @   F*U + @     F*Y + ZET) + d T^d X*(@   F*U - @ F
          U X     U Y       U PSI                       T U       T

               2
    + @     F*U  + @   F + @   F*U + 2*@     F*Y + @     F*U*Y
       U PSI        X X     X Y         X PSI       Y PSI

                 2
    + @       F*Y  - @   F*U + U*XI) + d T^d Y
       PSI PSI        PSI

*( - @   F - @     F*U + @   F + @   F*U + @     F*Y + @   F - XI)
      T U     U PSI       X Y     Y Y       Y PSI       PSI

 + d U^d X*@   F*U - d U^d Y*@   F
            U U               U U

 + d X^d Y*( - @   F - @   F*U - @     F*Y + ZET)
                U X     U Y       U PSI


let zet=-@(f,u,x)-@(f,u,y)*u-@(f,u,psi)*y;



i2;


                                  2
d T^d X*(@   F*U - @ F + @     F*U  + @   F + @   F*U + 2*@     F*Y
          T U       T     U PSI        X X     X Y         X PSI

                                     2
          + @     F*U*Y + @       F*Y  - @   F*U + U*XI) + d T^d Y
             Y PSI         PSI PSI        PSI

*( - @   F - @     F*U + @   F + @   F*U + @     F*Y + @   F - XI)
      T U     U PSI       X Y     Y Y       Y PSI       PSI

 + d U^d X*@   F*U - d U^d Y*@   F
            U U               U U

 - (2*d X^d Y)*(@   F + @   F*U + @     F*Y)
                 U X     U Y       U PSI


let xi=-@(f,t,u)-u*@(f,u,psi)+@(f,x,y)+u*@(f,y,y)+y*@(f,y,psi)+@(f,psi);



i2;


                                                           2
d T^d X*( - @ F + @   F + 2*@   F*U + 2*@     F*Y + @   F*U
             T     X X       X Y         X PSI       Y Y

                                       2
          + 2*@     F*U*Y + @       F*Y ) + d U^d X*@   F*U
               Y PSI         PSI PSI                 U U

 - d U^d Y*@   F - (2*d X^d Y)*(@   F + @   F*U + @     F*Y)
            U U                  U X     U Y       U PSI


let @(f,u,u)=0;



i2;


                                                           2
d T^d X*( - @ F + @   F + 2*@   F*U + 2*@     F*Y + @   F*U
             T     X X       X Y         X PSI       Y Y

                                       2
          + 2*@     F*U*Y + @       F*Y )
               Y PSI         PSI PSI

 - (2*d X^d Y)*(@   F + @   F*U + @     F*Y)
                 U X     U Y       U PSI
      % These PDE's have to be solved;


clear a,da,b,v,i1,i11,o,i2,xi,t;


remfdomain f;


clear @(f,u,u);




%Problem:
%--------
%Calculate the integrability conditions for the system of PDE's:
%(c.f. B.F. Schutz, "Geometrical Methods of Mathematical Physics"
%Cambridge University Press, 1984, p. 156)


% @ z /@ x + a1*z  + b1*z  = c1
%    1           1       2

% @ z /@ y + a2*z  + b2*z  = c2
%    1           1       2

% @ z /@ x + f1*z  + g1*z  = h1
%    2           1       2

% @ z /@ y + f2*z  + g2*z  = h2
%    2           1       2      ;


pform w(k)=1,integ(k)=4,z(k)=0,x=0,y=0,a=1,b=1,c=1,f=1,g=1,h=1,
      a1=0,a2=0,b1=0,b2=0,c1=0,c2=0,f1=0,f2=0,g1=0,g2=0,h1=0,h2=0;



fdomain  a1=a1(x,y),a2=a2(x,y),b1=b1(x,y),b2=b2(x,y),
         c1=c1(x,y),c2=c2(x,y),f1=f1(x,y),f2=f2(x,y),
         g1=g1(x,y),g2=g2(x,y),h1=h1(x,y),h2=h2(x,y);




a:=a1*d x+a2*d y$


b:=b1*d x+b2*d y$


c:=c1*d x+c2*d y$


f:=f1*d x+f2*d y$


g:=g1*d x+g2*d y$


h:=h1*d x+h2*d y$



%The equivalent exterior system:;
factor d;


w(1) := d z(-1) + z(-1)*a + z(-2)*b - c;


 1
W  := d Z  + d X*(Z *A1 + Z *B1 - C1) + d Y*(Z *A2 + Z *B2 - C2)
         1         1       2                  1       2

w(2) := d z(-2) + z(-1)*f + z(-2)*g - h;


 2
W  := d Z  + d X*(Z *F1 + Z *G1 - H1) + d Y*(Z *F2 + Z *G2 - H2)
         2         1       2                  1       2

indexrange 1,2;


factor z;


%The integrability conditions:;

integ(k) := d w(k) ^ w(1) ^ w(2);

     1
INTEG  := d Z ^d Z ^d X^d Y*Z *( - @ A1 + @ A2 + B1*F2 - B2*F1) + 
             1    2          1      Y      X

          d Z ^d Z ^d X^d Y*Z
             1    2          2

          *( - @ B1 + @ B2 + A1*B2 - A2*B1 + B1*G2 - B2*G1) + 
                Y      X

          d Z ^d Z ^d X^d Y
             1    2

          *(@ C1 - @ C2 - A1*C2 + A2*C1 - B1*H2 + B2*H1)
             Y      X

     2
INTEG  := d Z ^d Z ^d X^d Y*Z
             1    2          1

          *( - @ F1 + @ F2 - A1*F2 + A2*F1 - F1*G2 + F2*G1)
                Y      X

           + d Z ^d Z ^d X^d Y*Z *( - @ G1 + @ G2 - B1*F2 + B2*F1) + 
                1    2          2      Y      X

          d Z ^d Z ^d X^d Y
             1    2

          *(@ H1 - @ H2 + C1*F2 - C2*F1 - G1*H2 + G2*H1)
             Y      X



clear a,b,c,f,g,h,w(k),integ(k);



%Problem:
%--------
%Calculate the PDE's for the generators of the d-theta symmetries of
%the Lagrangian system of the planar Kepler problem.
%c.f. W.Sarlet, F.Cantrijn, Siam Review 23, 467, 1981;
%Verify that time translation is a d-theta symmetry and calculate the
%corresponding integral;

pform t=0,q(k)=0,v(k)=0,lam(k)=0,tau=0,xi(k)=0,et(k)=0,theta=1,f=0,
      l=0,glq(k)=0,glv(k)=0,glt=0;



tvector gam,y;



indexrange 1,2;



fdomain tau=tau(t,q(k),v(k)),xi=xi(t,q(k),v(k)),f=f(t,q(k),v(k));



l:=1/2*(v(1)**2+v(2)**2)+m/r$

      %The Lagrangian;

pform r=0;


fdomain r=r(q(k));


let @(r,q 1)=q(1)/r,@(r,q 2)=q(2)/r,q(1)**2+q(2)**2=r**2;



lam(k):=-m*q(k)/r;

             1
   1      - Q *M
LAM  := ---------
            R

             2
   2      - Q *M
LAM  := ---------
            R

                                %The force;

gam:=@ t + v(k)*@(q(k)) + lam(k)*@(v(k))$



et(k) := gam _| d xi(k) - v(k)*gam _| d tau$



y  :=tau*@ t + xi(k)*@(q(k)) + et(k)*@(v(k))$

     %Symmetry generator;

theta := l*d t + @(l,v(k))*(d q(k) - v(k)*d t)$



factor @;



s := y |_ theta - d f$



glq(k):=@(q k) _|s;

                                                1   1
                                        - @  (XI )*Q *M
                                            1
   1            1   1         1   2        V
GLQ  := 2*@  (XI )*V  + @  (XI )*V  + ------------------
            1             2                   R
           Q             Q

                     1   2
             - @  (XI )*Q *M
                 2
                V                    1          2   2
         + ------------------ + @ (XI ) + @  (XI )*V  - @  F
                   R             T          1             1
                                           Q             Q

                           1 2       2 2
            @  TAU*( - 3*(V ) *R - (V ) *R + 2*M)
              1
             Q                                               1  2
         + --------------------------------------- - @  TAU*V *V
                             2*R                       2
                                                      Q

                    1  1               2  1
            @  TAU*Q *V *M     @  TAU*Q *V *M
              1                  2
             V                  V                       1
         + ---------------- + ---------------- - @ TAU*V
                  R                  R            T

   2          1   1         2   1           2   2
GLQ  := @  (XI )*V  + @  (XI )*V  + 2*@  (XI )*V
          2             1               2
         Q             Q               Q

                     2   1                2   2
             - @  (XI )*Q *M      - @  (XI )*Q *M
                 1                    2
                V                    V                    2
         + ------------------ + ------------------ + @ (XI ) - @  F
                   R                    R             T          2
                                                                Q

                                        1 2         2 2
                           @  TAU*( - (V ) *R - 3*(V ) *R + 2*M)
                             2
                   1  2     Q
         - @  TAU*V *V  + ---------------------------------------
             1                              2*R
            Q

                    1  2               2  2
            @  TAU*Q *V *M     @  TAU*Q *V *M
              1                  2
             V                  V                       2
         + ---------------- + ---------------- - @ TAU*V
                  R                  R            T


glv(k):=@(v k) _|s;

   1          1   1         2   2
GLV  := @  (XI )*V  + @  (XI )*V  - @  F
          1             1             1
         V             V             V

                         1 2       2 2
            @  TAU*( - (V ) *R - (V ) *R + 2*M)
              1
             V
         + -------------------------------------
                            2*R

   2          1   1         2   2
GLV  := @  (XI )*V  + @  (XI )*V  - @  F
          2             2             2
         V             V             V

                         1 2       2 2
            @  TAU*( - (V ) *R - (V ) *R + 2*M)
              2
             V
         + -------------------------------------
                            2*R


glt:=@(t) _|s;


                                                   1   1  1
                                             @  (XI )*Q *V *M
                                               1
                1    1 2         1   1  2     V
GLT :=  - @  (XI )*(V )  - @  (XI )*V *V  + ------------------
            1                2                      R
           Q                Q

                 1   2  1
           @  (XI )*Q *V *M
             2
            V                        2   1  2         2    2 2
        + ------------------ - @  (XI )*V *V  - @  (XI )*(V )
                  R              1                2
                                Q                Q

                 2   1  2             2   2  2
           @  (XI )*Q *V *M     @  (XI )*Q *V *M
             1                    2
            V                    V
        + ------------------ + ------------------ - @ F
                  R                    R             T

                  1    1 2     2 2            2    1 2     2 2
        + @  TAU*V *((V )  + (V ) ) + @  TAU*V *((V )  + (V ) )
            1                           2
           Q                           Q

                    1       1 2     2 2
           (@  TAU*Q *M)*((V )  + (V ) )
              1
             V
        - -------------------------------
                         R

                    2       1 2     2 2
           (@  TAU*Q *M)*((V )  + (V ) )
              2
             V
        - -------------------------------
                         R

                    1 2       2 2
           @ TAU*((V ) *R + (V ) *R + 2*M)         1   1    2   2
            T                                  M*(Q *XI  + Q *XI )
        + --------------------------------- - ---------------------
                         2*R                            3
                                                       R


%Translation in time must generate a symmetry;
xi(k) := 0;


  K
XI  := 0

tau := 1;


TAU := 1


glq k;

  1
NS  :=  - @  F
            1
           Q

  2
NS  :=  - @  F
            2
           Q


glv k;

  1
NS  :=  - @  F
            1
           V

  2
NS  :=  - @  F
            2
           V


glt;


 - @ F
    T


%The corresponding integral is of course the energy;
integ := - y _| theta;


            1 2       2 2
          (V ) *R + (V ) *R - 2*M
INTEG := -------------------------
                    2*R



clear l,lam k,gam,et k,y,theta,s,glq k,glv k,glt,t,q k,v k,tau,xi k;


remfdomain r,f;



%Problem:
%--------
%Calculate the "gradient" and "Laplacian" of a function and the "curl"
%and "divergence" of a one-form in elliptic coordinates;


coframe e u=sqrt(cosh(v)**2-sin(u)**2)*d u,
        e v=sqrt(cosh(v)**2-sin(u)**2)*d v,
       e ph=cos u*sinh v*d ph;



pform f=0;



fdomain f=f(u,v,ph);



factor e,^;


on rat,gcd;


order cosh v, sin u;


%The gradient:;
d f;


                U                               V
           @ F*E                           @ F*E
            U                               V
----------------------------- + -----------------------------
               2          2                    2          2
 SQRT( - SIN(U)  + COSH(V) )     SQRT( - SIN(U)  + COSH(V) )

             PH
       @  F*E
        PH
 + ----------------
    COS(U)*SINH(V)


factor @;


%The Laplacian:;
# d # d f;


       @   F                    @ F*SIN(U)
        U U                      U
-------------------- - -----------------------------
        2         2                    2         2
 COSH(V)  - SIN(U)      COS(U)*(COSH(V)  - SIN(U) )

          @   F                    @ F*COSH(V)
           V V                      V
 + -------------------- + ------------------------------
           2         2                     2         2
    COSH(V)  - SIN(U)      SINH(V)*(COSH(V)  - SIN(U) )

        @     F
         PH PH
 + ------------------
          2        2
    COS(U) *SINH(V)


%Another way of calculating the Laplacian:
-#vardf(1/2*d f^#d f,f);


       @   F                    @ F*SIN(U)
        U U                      U
-------------------- - -----------------------------
        2         2                    2         2
 COSH(V)  - SIN(U)      COS(U)*(COSH(V)  - SIN(U) )

          @   F                    @ F*COSH(V)
           V V                      V
 + -------------------- + ------------------------------
           2         2                     2         2
    COSH(V)  - SIN(U)      SINH(V)*(COSH(V)  - SIN(U) )

        @     F
         PH PH
 + ------------------
          2        2
    COS(U) *SINH(V)


remfac @;



%Now calculate the "curl" and the "divergence" of a one-form;

pform w=1,a(k)=0;



fdomain a=a(u,v,ph);



w:=a(-k)*e k;


      U       V       PH
W := E *A  + E *A  + E  *A
         U       V        PH

%The curl:;
x := # d w;


       U                                     2          2
X := (E *(COSH(V)*A  *COS(U) - SQRT( - SIN(U)  + COSH(V) )*@  (A )
                   PH                                       PH  V

                                                     2          2
           + COS(U)*SINH(V)*@ (A  )))/(SQRT( - SIN(U)  + COSH(V) )
                             V  PH

                             V
        *COS(U)*SINH(V)) + (E *(SIN(U)*A  *SINH(V)
                                        PH

                            2          2
            + SQRT( - SIN(U)  + COSH(V) )*@  (A )
                                           PH  U

                                                      2          2
            - COS(U)*SINH(V)*@ (A  )))/(SQRT( - SIN(U)  + COSH(V) )
                              U  PH

                             PH            2                 2
        *COS(U)*SINH(V)) + (E  *( - COSH(V) *@ (A ) + COSH(V) *@ (A )
                                              V  U              U  V

                                         2                2
            - COSH(V)*A *SINH(V) + SIN(U) *@ (A ) - SIN(U) *@ (A )
                       U                    V  U             U  V

                                                2          2
            - SIN(U)*A *COS(U)))/(SQRT( - SIN(U)  + COSH(V) )
                      V

                 2         2
        *(COSH(V)  - SIN(U) ))


factor @;


%The divergence;
y := # d # w;


                @ (A )                          @ (A )
                 U  U                            V  V
Y := ----------------------------- + -----------------------------
                    2          2                    2          2
      SQRT( - SIN(U)  + COSH(V) )     SQRT( - SIN(U)  + COSH(V) )

            @  (A  )
             PH  PH                3
      + ---------------- + (COSH(V) *A *COS(U)
         COS(U)*SINH(V)               V

                  2                                   2
         - COSH(V) *SIN(U)*A *SINH(V) - COSH(V)*SIN(U) *A *COS(U)
                            U                            V

                                    2         3
         + COSH(V)*A *COS(U)*SINH(V)  + SIN(U) *A *SINH(V)
                    V                            U

                           2                         2          2
         - SIN(U)*A *COS(U) *SINH(V))/(SQRT( - SIN(U)  + COSH(V) )
                   U

                                2         2
        *COS(U)*SINH(V)*(COSH(V)  - SIN(U) ))



remfac @;


clear x,y,w,u,v,ph,e k,a k;


remfdomain a,f;




%Problem:
%--------
%Calculate in a spherical coordinate system the Navier Stokes equations;

coframe e r=d r,e th=r*d th,e ph=r*sin th*d ph;


frame x;



fdomain v=v(t,r,th,ph),p=p(r,th,ph);



pform v(k)=0,p=0,w=1;



%We first calculate the convective derivative;

w := v(-k)*e(k)$



factor e;

 on rat;



cdv := @(w,t) + (v(k)*x(-k)) |_ w - 1/2*d(v(k)*v(-k));


         R                             2
CDV := (E *(V *SIN(TH)*@ (V )*R - (V  ) *SIN(TH) + V  *@  (V )
             R          R  R        PH              PH  PH  R

                    2
             - (V  ) *SIN(TH) + V  *SIN(TH)*@  (V )
                 TH              TH          TH  R

                                                  PH
             + SIN(TH)*@ (V )*R))/(SIN(TH)*R) + (E  *(V *V  *SIN(TH)
                        T  R                           R  PH

              + V *SIN(TH)*@ (V  )*R + V  *V  *COS(TH) + V  *@  (V  )
                 R          R  PH       PH  TH            PH  PH  PH

              + V  *SIN(TH)*@  (V  ) + SIN(TH)*@ (V  )*R))/(SIN(TH)*R
                 TH          TH  PH             T  PH

                TH
          ) + (E  *(V *V  *SIN(TH) + V *SIN(TH)*@ (V  )*R
                     R  TH            R          R  TH

                          2
                   - (V  ) *COS(TH) + V  *@  (V  )
                       PH              PH  PH  TH

                   + V  *SIN(TH)*@  (V  ) + SIN(TH)*@ (V  )*R))/(
                      TH          TH  TH             T  TH

          SIN(TH)*R)


%next we calculate the viscous terms;

visc := nu*(d#d# w - #d#d w) + nus*d#d# w;


          R                 2                  2
VISC := (E *( - 2*V *SIN(TH) *NU - 2*V *SIN(TH) *NUS
                   R                  R

              - 2*V  *SIN(TH)*COS(TH)*NU - V  *SIN(TH)*COS(TH)*NUS
                   TH                       TH

                       2           2             2           2
              + SIN(TH) *@   (V )*R *NU + SIN(TH) *@   (V )*R *NUS
                          R R  R                    R R  R

                         2                        2
              + 2*SIN(TH) *@ (V )*R*NU + 2*SIN(TH) *@ (V )*R*NUS
                            R  R                     R  R

                       2                        2
              + SIN(TH) *@     (V )*NU + SIN(TH) *@    (V  )*R*NUS
                          TH TH  R                 R TH  TH

                         2                      2
              - 2*SIN(TH) *@  (V  )*NU - SIN(TH) *@  (V  )*NUS
                            TH  TH                 TH  TH

              + SIN(TH)*COS(TH)*@  (V )*NU
                                 TH  R

              + SIN(TH)*COS(TH)*@ (V  )*R*NUS
                                 R  TH

              + SIN(TH)*@    (V  )*R*NUS - 2*SIN(TH)*@  (V  )*NU
                         R PH  PH                     PH  PH

                                                               2  2
              - SIN(TH)*@  (V  )*NUS + @     (V )*NU))/(SIN(TH) *R ) 
                         PH  PH         PH PH  R

            PH                2                 2
        + (E  *( - V  *SIN(TH) *NU - V  *COS(TH) *NU
                    PH                PH

                          2            2               2
                 + SIN(TH) *@   (V  )*R *NU + 2*SIN(TH) *@ (V  )*R*NU
                             R R  PH                      R  PH

                          2
                 + SIN(TH) *@     (V  )*NU
                             TH TH  PH

                 + SIN(TH)*COS(TH)*@  (V  )*NU
                                    TH  PH

                 + SIN(TH)*@    (V )*R*NUS + 2*SIN(TH)*@  (V )*NU
                            R PH  R                     PH  R

                 + 2*SIN(TH)*@  (V )*NUS + SIN(TH)*@     (V  )*NUS
                              PH  R                 PH TH  TH

                 + 2*COS(TH)*@  (V  )*NU + COS(TH)*@  (V  )*NUS
                              PH  TH                PH  TH

                                                              2  2
                 + @     (V  )*NU + @     (V  )*NUS))/(SIN(TH) *R ) +
                    PH PH  PH        PH PH  PH

           TH                2                 2
         (E  *( - V  *SIN(TH) *NU - V  *SIN(TH) *NUS
                   TH                TH

                             2                 2
                - V  *COS(TH) *NU - V  *COS(TH) *NUS
                   TH                TH

                         2                            2
                + SIN(TH) *@    (V )*R*NUS + 2*SIN(TH) *@  (V )*NU
                            R TH  R                      TH  R

                           2                      2            2
                + 2*SIN(TH) *@  (V )*NUS + SIN(TH) *@   (V  )*R *NU
                              TH  R                  R R  TH

                           2                       2
                + 2*SIN(TH) *@ (V  )*R*NU + SIN(TH) *@     (V  )*NU
                              R  TH                   TH TH  TH

                         2
                + SIN(TH) *@     (V  )*NUS
                            TH TH  TH

                + SIN(TH)*COS(TH)*@  (V  )*NU
                                   TH  TH

                + SIN(TH)*COS(TH)*@  (V  )*NUS
                                   TH  TH

                + SIN(TH)*@     (V  )*NUS - 2*COS(TH)*@  (V  )*NU
                           PH TH  PH                   PH  PH

                                                                  2
                - COS(TH)*@  (V  )*NUS + @     (V  )*NU))/(SIN(TH)
                           PH  PH         PH PH  TH

             2
           *R )


%finally we add the pressure term and print the components of the
%whole equation;

pform nasteq=1,nast(k)=0;



nasteq := cdv - visc + 1/rho*d p$



factor @;



nast(-k) := x(-k) _| nasteq;

                                   @ (V )*(V *R - 2*NU - 2*NUS)
                                    R  R    R
NAST  :=  - @   (V )*(NU + NUS) + ------------------------------
    R        R R  R                             R

                       - @     (V )*NU     @  (V )*V
                          PH PH  R          PH  R   PH
          + @ (V ) + ------------------ + -------------
             T  R              2  2         SIN(TH)*R
                        SIN(TH) *R

              - @     (V )*NU
                 TH TH  R
          + ------------------
                     2
                    R

             @  (V )*(V  *SIN(TH)*R - COS(TH)*NU)
              TH  R    TH
          + --------------------------------------
                                   2
                          SIN(TH)*R

              - @    (V  )*NUS     @  (V  )*(2*NU + NUS)
                 R PH  PH           PH  PH
          + ------------------- + -----------------------
                 SIN(TH)*R                       2
                                        SIN(TH)*R

              - @    (V  )*NUS      - @ (V  )*COS(TH)*NUS
                 R TH  TH              R  TH
          + ------------------- + ------------------------
                     R                   SIN(TH)*R

             @  (V  )*(2*NU + NUS)     @ P
              TH  TH                    R
          + ----------------------- + ----- + (2*V *SIN(TH)*NU
                       2               RHO        R
                      R

                                       2                  2
             + 2*V *SIN(TH)*NUS - (V  ) *SIN(TH)*R - (V  ) *SIN(TH)*R
                  R                 PH                 TH

                                                             2
             + 2*V  *COS(TH)*NU + V  *COS(TH)*NUS)/(SIN(TH)*R )
                  TH               TH

            - @    (V )*NUS     (2*@  (V ))*(NU + NUS)
               R TH  R              TH  R
NAST   := ------------------ - ------------------------
    TH            R                        2
                                          R

               - @     (V  )*NUS     @  (V  )*COS(TH)*(2*NU + NUS)
                  PH TH  PH           PH  PH
           + -------------------- + -------------------------------
                           2                         2  2
                  SIN(TH)*R                   SIN(TH) *R

                             @ (V  )*(V *R - 2*NU)
                              R  TH    R
           - @   (V  )*NU + ----------------------- + @ (V  )
              R R  TH                  R               T  TH

               - @     (V  )*NU     @  (V  )*V
                  PH PH  TH          PH  TH   PH
           + ------------------- + --------------
                        2  2         SIN(TH)*R
                 SIN(TH) *R

              @     (V  )*(NU + NUS)
               TH TH  TH
           - ------------------------
                         2
                        R

              @  (V  )*(V  *SIN(TH)*R - COS(TH)*NU - COS(TH)*NUS)
               TH  TH    TH
           + -----------------------------------------------------
                                           2
                                  SIN(TH)*R

              @  P
               TH                     2          2
           + ------- + (V *V  *SIN(TH) *R - (V  ) *SIN(TH)*COS(TH)*R
              R*RHO      R  TH                PH

                           2                 2                  2
              + V  *SIN(TH) *NU + V  *SIN(TH) *NUS + V  *COS(TH) *NU
                 TH                TH                 TH

                           2              2  2
              + V  *COS(TH) *NUS)/(SIN(TH) *R )
                 TH

            - @    (V )*NUS     (2*@  (V ))*(NU + NUS)
               R PH  R              PH  R
NAST   := ------------------ - ------------------------
    PH        SIN(TH)*R                        2
                                      SIN(TH)*R

                             @ (V  )*(V *R - 2*NU)
                              R  PH    R
           - @   (V  )*NU + ----------------------- + @ (V  )
              R R  PH                  R               T  PH

              @     (V  )*(NU + NUS)     @  (V  )*V
               PH PH  PH                  PH  PH   PH
           - ------------------------ + --------------
                          2  2            SIN(TH)*R
                   SIN(TH) *R

               - @     (V  )*NU
                  TH TH  PH
           + -------------------
                      2
                     R

              @  (V  )*(V  *SIN(TH)*R - COS(TH)*NU)
               TH  PH    TH
           + ---------------------------------------
                                    2
                           SIN(TH)*R

               - @     (V  )*NUS
                  PH TH  TH
           + --------------------
                           2
                  SIN(TH)*R

              @  (V  )*COS(TH)*( - 2*NU - NUS)         @  P
               PH  TH                                   PH
           + ---------------------------------- + --------------- + (
                               2  2                SIN(TH)*R*RHO
                        SIN(TH) *R

                            2                                    2
             V  *(V *SIN(TH) *R + V  *SIN(TH)*COS(TH)*R + SIN(TH) *NU
              PH   R               TH

                          2              2  2
                 + COS(TH) *NU))/(SIN(TH) *R )



remfac @,e;



clear v k,x k,nast k,cdv,visc,p,w,nasteq;


remfdomain p,v;




%Problem:
%--------
%Calculate from the Lagrangian of a vibrating rod the equation of
% motion and show that the invariance under time translation leads
% to a conserved current;

pform y=0,x=0,t=0,q=0,j=0,lagr=2;



fdomain y=y(x,t),q=q(x),j=j(x);



factor ^;



lagr:=1/2*(rho*q*@(y,t)**2-e*j*@(y,x,x)**2)*d x^d t;


                        2              2
         d T^d X*( - @ Y *Q*RHO + @   Y *E*J)
                      T            X X
LAGR := --------------------------------------
                          2


vardf(lagr,y);


d T^d X

*(@   J*@   Y*E + 2*@ J*@     Y*E + @   Y*Q*RHO + @       Y*E*J)
   X X   X X         X   X X X       T T           X X X X


%The Lagrangian does not explicitly depend on time; therefore the
%vector field @ t generates a symmetry. The conserved current is

pform c=1;


factor d;



c := noether(lagr,y,@ t);


C := d T*E*(@ J*@ Y*@   Y - @   Y*@   Y*J + @ Y*@     Y*J)
             X   T   X X     T X   X X       T   X X X

                 2              2
         d X*(@ Y *Q*RHO + @   Y *E*J)
               T            X X
      - -------------------------------
                       2


%The exterior derivative of this must be zero or a multiple of the
%equation of motion (weak conservation law) to be a conserved current;

remfac d;



d c;


d T^d X*@ Y
         T

*( - @   J*@   Y*E - 2*@ J*@     Y*E - @   Y*Q*RHO - @       Y*E*J)
      X X   X X         X   X X X       T T           X X X X


%i.e. it is a multiple of the equation of motion;

clear lagr,c;




%Problem:
%--------
%Show that the metric structure given by Eguchi and Hanson induces a
%self-dual curvature.
%c.f. T. Eguchi, P.B. Gilkey, A.J. Hanson, "Gravitation, Gauge Theories
% and Differential Geometry", Physics Reports 66, 213, 1980;

for all x let cos(x)**2=1-sin(x)**2;



pform f=0,g=0;


fdomain f=f(r), g=g(r);



coframe   o(r) =f*d r,
      o(theta) =(r/2)*(sin(psi)*d theta-sin(theta)*cos(psi)*d phi),
        o(phi) =(r/2)*(-cos(psi)*d theta-sin(theta)*sin(psi)*d phi),
        o(psi) =(r/2)*g*(d psi+cos(theta)*d phi);



frame e;




pform gamma1(a,b)=1,curv2(a,b)=2;


antisymmetric gamma1,curv2;



factor o;



gamma1(-a,-b):=-(1/2)*( e(-a) _|(e(-c) _|(d o(-b)))
                       -e(-b) _|(e(-a) _|(d o(-c)))
                       +e(-c) _|(e(-b) _|(d o(-a))) )*o(c)$




curv2(-a,b):=d gamma1(-a,b) + gamma1(-c,b)^gamma1(-a,c)$



factor ^;



curv2(a,b):= curv2(a,b)$



let f=1/g;


let g=sqrt(1-(a/r)**4);


pform chck(k,l)=2;


antisymmetric chck;


%The following has to be zero for a self-dual curvature;

chck(k,l):=1/2*eps(k,l,m,n)*curv2(-m,-n)+curv2(k,l);

    PHI PSI
CHCK        := 0

    R PSI
CHCK      := 0

    R THETA
CHCK        := 0

    R PHI
CHCK      := 0

    THETA PSI
CHCK          := 0

    THETA PHI
CHCK          := 0



clear gamma1(a,b),curv2(a,b),f,g,chck(a,b),o(k),e(k);


remfdomain f,g;



%Problem:
%--------
%Calculate for a given coframe and given torsion the Riemannian part and
%the torsion induced part of the connection. Calculate the curvature.

%For a more elaborate example see E.Schruefer, F.W. Hehl, J.D. McCrea,
%"Application of the REDUCE package EXCALC to the Poincare gauge field
%theory of gravity", to be submited to GRG Journal;

pform ff=0, gg=0;



fdomain ff=ff(r), gg=gg(r);



coframe o(4)=d u+2*b0*cos(theta)*d phi,
        o(1)=ff*(d u+2*b0*cos(theta)*d phi)+ d r,
        o(2)=gg*d theta,
        o(3)=gg*sin(theta)*d phi
 with metric g=-o(4)*o(1)-o(4)*o(1)+o(2)*o(2)+o(3)*o(3);



frame e;



pform tor(a)=2,gwt(a)=2,gam(a,b)=1,
      u1=0,u3=0,u5=0;



antisymmetric gam;



fdomain u1=u1(r),u3=u3(r),u5=u5(r);



tor(4):=0$



tor(1):=-u5*o(4)^o(1)-2*u3*o(2)^o(3)$



tor(2):=u1*o(4)^o(2)+u3*o(4)^o(3)$



tor(3):=u1*o(4)^o(3)-u3*o(4)^o(2)$



gwt(-a):=d o(-a)-tor(-a)$



%The following is the combined connection;
%The Riemannian part could have equally well been calculated by the
%RIEMANNCONX statement;

gam(-a,-b):=(1/2)*( e(-b) _|(e(-c) _|gwt(-a))
                   +e(-c) _|(e(-a) _|gwt(-b))
                   -e(-a) _|(e(-b) _|gwt(-c)) )*o(c);

            1         3                 4              2
           O *B0     O *COS(THETA)     O *(FF*B0 - 2*GG *U3)
GAM    := ------- + --------------- + -----------------------
   2 3        2      SIN(THETA)*GG                2
            GG                                  GG

                                    3
            2            2         O *(@ GG*FF + GG*U1)
           O *(FF*B0 - GG *U3)          R
GAM    := --------------------- - ----------------------
   4 3               2                      GG
                   GG

           4
GAM    := O *(@ FF - U5)
   4 1         R

               2
              O *(@ GG*FF + GG*U1)      3               2
                   R                   O *( - FF*B0 + GG *U3)
GAM    :=  - ---------------------- + ------------------------
   4 2                 GG                         2
                                                GG

                      3
            2        O *@ GG
           O *B0         R
GAM    := ------- + ---------
   1 3        2        GG
            GG

            2
           O *@ GG         3
               R        - O *B0
GAM    := --------- + ----------
   1 2       GG            2
                         GG



pform curv(a,b)=2;


antisymmetric curv;


factor ^;



curv(-a,b):=d gam(-a,b) + gam(-c,b)^gam(-a,c);

      4        2  3                                     2
CURV    := (2*O ^O *(@ FF*GG*B0 - 2*@ GG*FF*B0 + @ GG*GG *U3
    4                 R              R            R

                                          3    4  1
                - GG*B0*U1 - GG*B0*U5))/GG  + O ^O *(@   FF - @ U5)
                                                      R R      R

      4
CURV    := 0
    1 

             1  2           3     2
            O ^O *(@   GG*GG  - B0 )
      4             R R                   4  2                 3
CURV    := -------------------------- + (O ^O *( - @ FF*@ GG*GG
    2                   4                           R    R
                      GG

                                3          3           2
                  - @   GG*FF*GG  + @ GG*GG *U5 - FF*B0
                     R R             R

                        2           4     4  3
                  + 2*GG *B0*U3))/GG  + (O ^O

                                                     2
              *(@ FF*GG*B0 - 2*@ GG*FF*B0 + 2*@ GG*GG *U3 - GG*B0*U5)
                 R              R              R

                  3
              )/GG

             1  3           3     2
            O ^O *(@   GG*GG  - B0 )
      4             R R                   4  2
CURV    := -------------------------- + (O ^O *( - @ FF*GG*B0
    3                   4                           R
                      GG

                                            2                   3
                  + 2*@ GG*FF*B0 - 2*@ GG*GG *U3 + GG*B0*U5))/GG  + (
                       R              R

               4  3                 3               3          3
              O ^O *( - @ FF*@ GG*GG  - @   GG*FF*GG  + @ GG*GG *U5
                         R    R          R R             R

                         2       2           4
                  - FF*B0  + 2*GG *B0*U3))/GG

      1
CURV    := 0
    4 

      1        2  3                                        2
CURV    := (2*O ^O *( - @ FF*GG*B0 + 2*@ GG*FF*B0 - @ GG*GG *U3
    1                    R              R            R

                                          3
                + GG*B0*U1 + GG*B0*U5))/GG

               4  1
            + O ^O *( - @   FF + @ U5)
                         R R      R

      1      1  2                 3               3          3
CURV    := (O ^O *( - @ FF*@ GG*GG  - @   GG*FF*GG  - @ GG*GG *U1
    2                  R    R          R R             R

                         4        2     2           4     1  3
                - @ U1*GG  - FF*B0  + GG *B0*U3))/GG  + (O ^O *(
                   R

                                                       2
                  - @ FF*GG*B0 + 2*@ GG*FF*B0 + @ GG*GG *U3
                     R              R            R

                           3                3     4  2
                  + @ U3*GG  + GG*B0*U1))/GG  + (O ^O *(
                     R

                           4               2   3             3
                  - @ FF*GG *U1 + @   GG*FF *GG  + @ GG*FF*GG *U1
                     R             R R              R

                              3                4     2   2
                  + @ GG*FF*GG *U5 + @ U1*FF*GG  - FF *B0
                     R                R

                           2           4             4   2     4
                  + 3*FF*GG *B0*U3 + GG *U1*U5 - 2*GG *U3 ))/GG  + (

               4  3         2                                  2
              O ^O *(@ FF*GG *U3 - 3*@ GG*FF*GG*U3 - @ U3*FF*GG
                      R               R               R

                                              2           2
                  + FF*B0*U1 + FF*B0*U5 - 2*GG *U1*U3 - GG *U3*U5))/

             2
           GG

      1      1  2                                     2             3
CURV    := (O ^O *(@ FF*GG*B0 - 2*@ GG*FF*B0 - @ GG*GG *U3 - @ U3*GG
    3               R              R            R             R

                               3     1  3                 3
                - GG*B0*U1))/GG  + (O ^O *( - @ FF*@ GG*GG
                                               R    R

                                3          3             4        2
                  - @   GG*FF*GG  - @ GG*GG *U1 - @ U1*GG  - FF*B0
                     R R             R             R

                      2           4     4  2            2
                  + GG *B0*U3))/GG  + (O ^O *( - @ FF*GG *U3
                                                  R

                                                2
                  + 3*@ GG*FF*GG*U3 + @ U3*FF*GG  - FF*B0*U1
                       R               R

                                   2           2           2     4  3
                  - FF*B0*U5 + 2*GG *U1*U3 + GG *U3*U5))/GG  + (O ^O

                          4               2   3             3
              *( - @ FF*GG *U1 + @   GG*FF *GG  + @ GG*FF*GG *U1
                    R             R R              R

                             3                4     2   2
                 + @ GG*FF*GG *U5 + @ U1*FF*GG  - FF *B0
                    R                R

                          2           4             4   2     4
                 + 3*FF*GG *B0*U3 + GG *U1*U5 - 2*GG *U3 ))/GG

      2      1  2                 3               3          3
CURV    := (O ^O *( - @ FF*@ GG*GG  - @   GG*FF*GG  - @ GG*GG *U1
    4                  R    R          R R             R

                         4        2     2           4     1  3
                - @ U1*GG  - FF*B0  + GG *B0*U3))/GG  + (O ^O *(
                   R

                                                       2
                  - @ FF*GG*B0 + 2*@ GG*FF*B0 + @ GG*GG *U3
                     R              R            R

                           3                3     4  2
                  + @ U3*GG  + GG*B0*U1))/GG  + (O ^O *(
                     R

                           4               2   3             3
                  - @ FF*GG *U1 + @   GG*FF *GG  + @ GG*FF*GG *U1
                     R             R R              R

                              3                4     2   2
                  + @ GG*FF*GG *U5 + @ U1*FF*GG  - FF *B0
                     R                R

                           2           4             4   2     4
                  + 3*FF*GG *B0*U3 + GG *U1*U5 - 2*GG *U3 ))/GG  + (

               4  3         2                                  2
              O ^O *(@ FF*GG *U3 - 3*@ GG*FF*GG*U3 - @ U3*FF*GG
                      R               R               R

                                              2           2
                  + FF*B0*U1 + FF*B0*U5 - 2*GG *U1*U3 - GG *U3*U5))/

             2
           GG

             1  2           3     2
            O ^O *(@   GG*GG  - B0 )
      2             R R                   4  2                 3
CURV    := -------------------------- + (O ^O *( - @ FF*@ GG*GG
    1                   4                           R    R
                      GG

                                3          3           2
                  - @   GG*FF*GG  + @ GG*GG *U5 - FF*B0
                     R R             R

                        2           4     4  3
                  + 2*GG *B0*U3))/GG  + (O ^O

                                                     2
              *(@ FF*GG*B0 - 2*@ GG*FF*B0 + 2*@ GG*GG *U3 - GG*B0*U5)
                 R              R              R

                  3
              )/GG

      2
CURV    := 0
    2 

      2      2  3           2      2            3             2
CURV    := (O ^O *( - 2*@ GG *FF*GG  - 2*@ GG*GG *U1 + 6*FF*B0
    3                    R                R

                      2           2     4
                - 6*GG *B0*U3 + GG ))/GG

                  4  1                                     3
               2*O ^O *(@ FF*GG*B0 - 2*@ GG*FF*B0 - @ U3*GG )
                         R              R            R
            + ------------------------------------------------
                                      3
                                    GG

      3      1  2                                     2             3
CURV    := (O ^O *(@ FF*GG*B0 - 2*@ GG*FF*B0 - @ GG*GG *U3 - @ U3*GG
    4               R              R            R             R

                               3     1  3                 3
                - GG*B0*U1))/GG  + (O ^O *( - @ FF*@ GG*GG
                                               R    R

                                3          3             4        2
                  - @   GG*FF*GG  - @ GG*GG *U1 - @ U1*GG  - FF*B0
                     R R             R             R

                      2           4     4  2            2
                  + GG *B0*U3))/GG  + (O ^O *( - @ FF*GG *U3
                                                  R

                                                2
                  + 3*@ GG*FF*GG*U3 + @ U3*FF*GG  - FF*B0*U1
                       R               R

                                   2           2           2     4  3
                  - FF*B0*U5 + 2*GG *U1*U3 + GG *U3*U5))/GG  + (O ^O

                          4               2   3             3
              *( - @ FF*GG *U1 + @   GG*FF *GG  + @ GG*FF*GG *U1
                    R             R R              R

                             3                4     2   2
                 + @ GG*FF*GG *U5 + @ U1*FF*GG  - FF *B0
                    R                R

                          2           4             4   2     4
                 + 3*FF*GG *B0*U3 + GG *U1*U5 - 2*GG *U3 ))/GG

             1  3           3     2
            O ^O *(@   GG*GG  - B0 )
      3             R R                   4  2
CURV    := -------------------------- + (O ^O *( - @ FF*GG*B0
    1                   4                           R
                      GG

                                            2                   3
                  + 2*@ GG*FF*B0 - 2*@ GG*GG *U3 + GG*B0*U5))/GG  + (
                       R              R

               4  3                 3               3          3
              O ^O *( - @ FF*@ GG*GG  - @   GG*FF*GG  + @ GG*GG *U5
                         R    R          R R             R

                         2       2           4
                  - FF*B0  + 2*GG *B0*U3))/GG

      3      2  3        2      2            3             2
CURV    := (O ^O *(2*@ GG *FF*GG  + 2*@ GG*GG *U1 - 6*FF*B0
    2                 R                R

                      2           2     4
                + 6*GG *B0*U3 - GG ))/GG

                  4  1                                        3
               2*O ^O *( - @ FF*GG*B0 + 2*@ GG*FF*B0 + @ U3*GG )
                            R              R            R
            + ---------------------------------------------------
                                        3
                                      GG

      3
CURV    := 0
    3 





showtime;


Time: 68391 ms

end;

4: 4: 
Quitting
Sat Jun 29 14:11:05 PDT 1991
