/*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy.  Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov.  NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly.  Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/

#include "REAL.H"
#include "ArrayLim.H"

#define SDIM 3

      subroutine TRANSV(v,DIMS(v),dx,domnlo,v1,DIMS(v1),v2,DIMS(v2))
      implicit none
      integer DIMDEC(v)
      integer DIMDEC(v1)
      integer DIMDEC(v2)
      REAL_T  v(DIMV(v),*)
      REAL_T v1(DIMV(v),*)
      REAL_T v2(DIMV(v),*)
      REAL_T dx(SDIM), domnlo(SDIM)
      integer i,j,k
      REAL_T x,y,vx,vy,vz,vr,vt,r,st,ct

      do j=ARG_L2(v),ARG_H2(v)

         do k=ARG_L3(v),ARG_H3(v)
            y = (float(k)+0.5d0)*dx(3)+domnlo(3)
            do i=ARG_L1(v),ARG_H1(v)
               x = (float(i)+0.5d0)*dx(1)+domnlo(1)

               vx = v(i,j,k,1)*1.d-2
               vy = v(i,j,k,3)*1.d-2
               vz = v(i,j,k,2)*1.d-2

               r = SQRT(x*x + y*y)
               if (r.le.2.5d0) then

                  if (r.lt.1.d-10) then
                     print *,'PUKE! illdefined if r=0'
                     call bl_abort(" ")
                  else
                     st = y / r
                     ct = x / r
                     vr = vx*ct + vy*st
                     vt = vy*ct - vx*st
                  endif
                  
               else 

                  vr = 0.d0
                  vt = 0.d0
                  vz = 0.d0

               endif

               v1(i,j,k,1) = vr
               v1(i,j,k,2) = vt
               v1(i,j,k,3) = vz

               v2(i,j,k,1) = vr*vr
               v2(i,j,k,2) = vt*vt
               v2(i,j,k,3) = vz*vz

            enddo
         enddo
      enddo

      end

      
      subroutine ROOTMS(v1, v2, DIMS(v))
      implicit none
      integer DIMDEC(v)
      REAL_T v1(DIMV(v),3)
      REAL_T v2(DIMV(v),3)
      integer i,j,k,n

      do k=ARG_L3(v),ARG_H3(v)
         do j=ARG_L2(v),ARG_H2(v)
            do i=ARG_L1(v),ARG_H1(v)
               do n=1,3
                  v2(i,j,k,n) = sqrt(abs(v2(i,j,k,n) - v1(i,j,k,n)**2))
               enddo
            enddo
         enddo
      enddo
      end
