Initial commit

2016-02-03 18:52:05 +00:00
commit d40505e161
507 changed files with 91383 additions and 0 deletions
@@ -0,0 +1,66 @@
+      PROGRAM sphoot
+      INTEGER i,m,n,nvar,N2
+      PARAMETER (N2=1)
+      REAL c2,dx,gamma,q1,x1,x2,v(N2)
+      LOGICAL check
+      COMMON /sphcom/ c2,gamma,dx,m,n
+      COMMON /caller/ x1,x2,nvar
+CU    USES newt
+      dx=1.e-4
+      nvar=3
+1     write(*,*) 'input m,n,c-squared (999 to end)'
+      read(*,*) m,n,c2
+      if (c2.eq.999.) stop
+      if ((n.lt.m).or.(m.lt.0)) goto 1
+      gamma=1.0
+      q1=n
+      do 11 i=1,m
+        gamma=-0.5*gamma*(n+i)*(q1/i)
+        q1=q1-1.0
+11    continue
+      v(1)=n*(n+1)-m*(m+1)+c2/2.0
+      x1=-1.0+dx
+      x2=0.0
+      call newt(v,N2,check)
+      if(check)then
+        write(*,*)'shoot failed; bad initial guess'
+      else
+        write(*,'(1x,t6,a)') 'mu(m,n)'
+        write(*,'(1x,f12.6)') v(1)
+        goto 1
+      endif
+      END
+      SUBROUTINE load(x1,v,y)
+      INTEGER m,n
+      REAL c2,dx,gamma,x1,y1,v(1),y(3)
+      COMMON /sphcom/ c2,gamma,dx,m,n
+      y(3)=v(1)
+      if(mod(n-m,2).eq.0)then
+        y1=gamma
+      else
+        y1=-gamma
+      endif
+      y(2)=-(y(3)-c2)*y1/(2*(m+1))
+      y(1)=y1+y(2)*dx
+      return
+      END
+      SUBROUTINE score(x2,y,f)
+      INTEGER m,n
+      REAL c2,dx,gamma,x2,f(1),y(3)
+      COMMON /sphcom/ c2,gamma,dx,m,n
+      if (mod(n-m,2).eq.0) then
+        f(1)=y(2)
+      else
+        f(1)=y(1)
+      endif
+      return
+      END
+      SUBROUTINE derivs(x,y,dydx)
+      INTEGER m,n
+      REAL c2,dx,gamma,x,dydx(3),y(3)
+      COMMON /sphcom/ c2,gamma,dx,m,n
+      dydx(1)=y(2)
+      dydx(2)=(2.0*x*(m+1.0)*y(2)-(y(3)-c2*x*x)*y(1))/(1.0-x*x)
+      dydx(3)=0.0
+      return
+      END