Initial commit

2016-02-03 18:52:05 +00:00
commit d40505e161
507 changed files with 91383 additions and 0 deletions
@@ -0,0 +1,70 @@
+      PROGRAM sphfpt
+      INTEGER i,m,n,nvar,nn2,N1,N2,NTOT
+      REAL DXX
+      PARAMETER (N1=2,N2=1,NTOT=N1+N2,DXX=1.e-4)
+      REAL c2,dx,gamma,q1,x1,x2,xf,v1(N2),v2(N1),v(NTOT)
+      LOGICAL check
+      COMMON /sphcom/ c2,gamma,dx,m,n
+      COMMON /caller/ x1,x2,xf,nvar,nn2
+      EQUIVALENCE (v1(1),v(1)),(v2(1),v(N2+1))
+CU    USES newt
+      nvar=NTOT
+      nn2=N2
+      dx=DXX
+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
+      v1(1)=n*(n+1)-m*(m+1)+c2/2.0
+      v2(2)=v1(1)
+      v2(1)=gamma*(1.-(v2(2)-c2)*dx/(2*(m+1)))
+      x1=-1.0+dx
+      x2=1.0-dx
+      xf=0.
+      call newt(v,NTOT,check)
+      if(check)then
+        write(*,*)'shootf failed; bad initial guess'
+      else
+        write(*,'(1x,t6,a)') 'mu(m,n)'
+        write(*,'(1x,f12.6)') v1(1)
+        goto 1
+      endif
+      END
+      SUBROUTINE load1(x1,v1,y)
+      INTEGER m,n
+      REAL c2,dx,gamma,x1,y1,v1(1),y(3)
+      COMMON /sphcom/ c2,gamma,dx,m,n
+      y(3)=v1(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 load2(x2,v2,y)
+      INTEGER m,n
+      REAL c2,dx,gamma,x2,v2(2),y(3)
+      COMMON /sphcom/ c2,gamma,dx,m,n
+      y(3)=v2(2)
+      y(1)=v2(1)
+      y(2)=(y(3)-c2)*y(1)/(2*(m+1))
+      return
+      END
+      SUBROUTINE score(xf,y,f)
+      INTEGER i,m,n
+      REAL c2,gamma,dx,xf,f(3),y(3)
+      COMMON /sphcom/ c2,gamma,dx,m,n
+      do 12 i=1,3
+        f(i)=y(i)
+12    continue
+      return
+      END