initial upload

docs/pages/fadpt_gyro.f

@@ -0,0 +1,78 @@
+      subroutine fadpt(x,y,z,mat,nvec,time,f)
+C #####################################################################
+C
+C     PURPOSE -
+C
+C        Adaption function for smoothing algorithms.  This is the
+C        'gyroscope' function wherein the function has large
+C        second derivatives near each of three rings in the
+C        three coordinate planes.
+C
+C     INPUT ARGUMENTS -
+C
+C        X,Y,Z - Input spatial coordinate arrays.
+C        MAT - Material type arrays.  (This is for cases where the
+C              function value depends BOTH on position and material
+C              type.)
+C        NV - Length of spatial arrays.  (Evaluate function at each
+C             spatial coordinate.)
+C        TIME  - Current time (for time dependent adaption).
+C
+C     OUTPUT ARGUMENTS -
+C
+C        F - Array of adaption function values.
+C
+C     CHANGE HISTORY -
+C
+C ######################################################################
+      implicit none
+ 
+      integer lenptr
+      parameter (lenptr=1000000)
+
+      real*8 x(lenptr),y(lenptr),z(lenptr),f(lenptr)
+      integer nvec, i, mat(lenptr)
+      real*8 r0,z0,epssq,r,dsq,x0,y0,time
+
+c.... Radius of rings
+
+      r0=0.5
+
+c.... Center of rings
+
+      x0=0.
+      y0=0.
+      z0=0.
+   
+c.... Square of epsilon.  The function does not go to infinity
+c.... on the ring because epsilon is nonzero.  More precisely, the
+c.... function is 
+c....                      f(x,y,z)=1/( d(x,y,z)**2 +epsilon**2 ).
+c....
+c.... That is, the function is 1 divided by the smallest distance
+c.... to any of the three rings (squared) plus epsilon squared.  
+c.... This implies that the 'characteristic length' of the function
+c.... AT each of the rings is epsilon.
+
+      epssq=.1**2
+
+c.... Loop over vector of input values and compute function values.
+
+      do i=1,nvec
+
+         r=sqrt(x(i)**2+y(i)**2)
+         dsq=(r-r0)**2+(z(i)-z0)**2
+
+         r=sqrt(y(i)**2+z(i)**2)
+         dsq=min(dsq,(r-r0)**2+(x(i)-x0)**2)
+
+         r=sqrt(z(i)**2+x(i)**2)
+         dsq=min(dsq,(r-r0)**2+(y(i)-y0)**2)
+
+         f(i)=1./(dsq+epssq)
+
+      enddo
+
+      return
+      end
+