diff -C1 -r 206b/recipes_f/COPYRIGHT.NOTICE 208/recipes_f/COPYRIGHT.NOTICE *** 206b/recipes_f/COPYRIGHT.NOTICE Wed Feb 07 19:47:47 1996 --- 208/recipes_f/COPYRIGHT.NOTICE Sun Jul 06 08:14:49 1997 *************** *** 1,2 **** The contents of this Numerical Recipes Fortran distribution are ! Copyright (C) 1986-1996 Numerical Recipes Software. --- 1,2 ---- The contents of this Numerical Recipes Fortran distribution are ! Copyright (C) 1986-1997 Numerical Recipes Software. diff -C1 -r 206b/recipes_f/demo/answers/xcaldat.reslt 208/recipes_f/demo/answers/xcaldat.reslt *** 206b/recipes_f/demo/answers/xcaldat.reslt Mon Oct 19 07:20:12 1992 --- 208/recipes_f/demo/answers/xcaldat.reslt Sun Jul 06 08:12:05 1997 *************** *** 6,8 **** January 1 1 1721424 January 1 1 ! October 14 1582 2299170 October 24 1582 October 15 1582 2299161 October 15 1582 --- 6,8 ---- January 1 1 1721424 January 1 1 ! October 4 1582 2299160 October 4 1582 October 15 1582 2299161 October 15 1582 diff -C1 -r 206b/recipes_f/demo/answers/xjulday.reslt 208/recipes_f/demo/answers/xjulday.reslt *** 206b/recipes_f/demo/answers/xjulday.reslt Mon Oct 19 07:28:10 1992 --- 208/recipes_f/demo/answers/xjulday.reslt Sun Jul 06 08:11:50 1997 *************** *** 5,7 **** January 1 1 1721424 One day later ! October 14 1582 2299170 Day before Gregorian calendar October 15 1582 2299161 Gregorian calendar adopted --- 5,7 ---- January 1 1 1721424 One day later ! October 4 1582 2299160 Day before Gregorian calendar October 15 1582 2299161 Gregorian calendar adopted diff -C1 -r 206b/recipes_f/demo/bin/DATES.DAT 208/recipes_f/demo/bin/DATES.DAT *** 206b/recipes_f/demo/bin/DATES.DAT Thu Sep 17 10:21:20 1992 --- 208/recipes_f/demo/bin/DATES.DAT Tue Jul 01 05:56:20 1997 *************** *** 4,6 **** 01 01 1 One day later ! 10 14 1582 Day before Gregorian calendar 10 15 1582 Gregorian calendar adopted --- 4,6 ---- 01 01 1 One day later ! 10 04 1582 Day before Gregorian calendar 10 15 1582 Gregorian calendar adopted diff -C1 -r 206b/recipes_f/demo/data/dates.dat 208/recipes_f/demo/data/dates.dat *** 206b/recipes_f/demo/data/dates.dat Thu Sep 17 10:21:20 1992 --- 208/recipes_f/demo/data/dates.dat Tue Jul 01 05:56:20 1997 *************** *** 4,6 **** 01 01 1 One day later ! 10 14 1582 Day before Gregorian calendar 10 15 1582 Gregorian calendar adopted --- 4,6 ---- 01 01 1 One day later ! 10 04 1582 Day before Gregorian calendar 10 15 1582 Gregorian calendar adopted diff -C1 -r 206b/recipes_f/demo/results/DATES.DAT 208/recipes_f/demo/results/DATES.DAT *** 206b/recipes_f/demo/results/DATES.DAT Thu Sep 17 10:21:20 1992 --- 208/recipes_f/demo/results/DATES.DAT Tue Jul 01 05:56:20 1997 *************** *** 4,6 **** 01 01 1 One day later ! 10 14 1582 Day before Gregorian calendar 10 15 1582 Gregorian calendar adopted --- 4,6 ---- 01 01 1 One day later ! 10 04 1582 Day before Gregorian calendar 10 15 1582 Gregorian calendar adopted diff -C1 -r 206b/recipes_f/doc/COMPILING 208/recipes_f/doc/COMPILING *** 206b/recipes_f/doc/COMPILING Sat Feb 24 13:12:29 1996 --- 208/recipes_f/doc/COMPILING Tue Jul 15 10:43:39 1997 *************** *** 87 **** --- 87,90 ---- workaround is to replace the line "j=1+iy/NDIV" with "j=1+(iy/8192)/8192" + + NeXT: + Use 'ranlib' instead of 'ar' in the master makefile. diff -C1 -r 206b/recipes_f/doc/COPYRIGHT.NOTICE 208/recipes_f/doc/COPYRIGHT.NOTICE *** 206b/recipes_f/doc/COPYRIGHT.NOTICE Wed Feb 07 19:47:47 1996 --- 208/recipes_f/doc/COPYRIGHT.NOTICE Sun Jul 06 08:14:49 1997 *************** *** 1,2 **** The contents of this Numerical Recipes Fortran distribution are ! Copyright (C) 1986-1996 Numerical Recipes Software. --- 1,2 ---- The contents of this Numerical Recipes Fortran distribution are ! Copyright (C) 1986-1997 Numerical Recipes Software. diff -C1 -r 206b/recipes_f/doc/VERSION 208/recipes_f/doc/VERSION *** 206b/recipes_f/doc/VERSION Sun Apr 23 09:10:36 1995 --- 208/recipes_f/doc/VERSION Sat Jul 19 09:26:11 1997 *************** *** 1,2 **** Numerical Recipes in FORTRAN ! Unix Version 2.06 --- 1,2 ---- Numerical Recipes in FORTRAN ! Unix Version 2.08 diff -C1 -r 206b/recipes_f/recipes/amebsa.f 208/recipes_f/recipes/amebsa.f *** 206b/recipes_f/recipes/amebsa.f Fri Sep 25 14:24:23 1992 --- 208/recipes_f/recipes/amebsa.f Mon Jul 14 20:32:33 1997 *************** *** 6,8 **** CU USES amotsa,funk,ran1 ! INTEGER i,idum,ihi,ilo,inhi,j,m,n REAL rtol,sum,swap,tt,yhi,ylo,ynhi,ysave,yt,ytry,psum(NMAX), --- 6,8 ---- CU USES amotsa,funk,ran1 ! INTEGER i,idum,ihi,ilo,j,m,n REAL rtol,sum,swap,tt,yhi,ylo,ynhi,ysave,yt,ytry,psum(NMAX), *************** *** 19,21 **** 2 ilo=1 - inhi=1 ihi=2 --- 19,20 ---- *************** *** 26,28 **** ihi=1 - inhi=2 ilo=2 --- 25,26 ---- *************** *** 39,41 **** if(yt.gt.yhi) then - inhi=ihi ynhi=yhi --- 37,38 ---- *************** *** 44,46 **** else if(yt.gt.ynhi) then - inhi=i ynhi=yt --- 41,42 ---- diff -C1 -r 206b/recipes_f/recipes/amoeba.f 208/recipes_f/recipes/amoeba.f *** 206b/recipes_f/recipes/amoeba.f Fri Sep 25 14:24:25 1992 --- 208/recipes_f/recipes/amoeba.f Mon Jul 14 20:32:33 1997 *************** *** 2,5 **** INTEGER iter,mp,ndim,np,NMAX,ITMAX ! REAL ftol,p(mp,np),y(mp),funk ! PARAMETER (NMAX=20,ITMAX=5000) EXTERNAL funk --- 2,5 ---- INTEGER iter,mp,ndim,np,NMAX,ITMAX ! REAL ftol,p(mp,np),y(mp),funk,TINY ! PARAMETER (NMAX=20,ITMAX=5000,TINY=1.e-10) EXTERNAL funk *************** *** 33,35 **** 13 continue ! rtol=2.*abs(y(ihi)-y(ilo))/(abs(y(ihi))+abs(y(ilo))) if (rtol.lt.ftol) then --- 33,35 ---- 13 continue ! rtol=2.*abs(y(ihi)-y(ilo))/(abs(y(ihi))+abs(y(ilo))+TINY) if (rtol.lt.ftol) then diff -C1 -r 206b/recipes_f/recipes/broydn.f 208/recipes_f/recipes/broydn.f *** 206b/recipes_f/recipes/broydn.f Wed Feb 02 09:01:43 1994 --- 208/recipes_f/recipes/broydn.f Mon Jul 14 20:32:36 1997 *************** *** 7,8 **** --- 7,9 ---- COMMON /newtv/ fvec(NP),nn + SAVE /newtv/ CU USES fdjac,fmin,lnsrch,qrdcmp,qrupdt,rsolv diff -C1 -r 206b/recipes_f/recipes/caldat.f 208/recipes_f/recipes/caldat.f *** 206b/recipes_f/recipes/caldat.f Fri Sep 25 14:24:54 1992 --- 208/recipes_f/recipes/caldat.f Mon Jul 14 20:32:36 1997 *************** *** 7,8 **** --- 7,10 ---- ja=julian+1+jalpha-int(0.25*jalpha) + else if(julian.lt.0)then + ja=julian+36525*(1-julian/36525) else *************** *** 20,21 **** --- 22,24 ---- if(iyyy.le.0)iyyy=iyyy-1 + if(julian.lt.0)iyyy=iyyy-100*(1-julian/36525) return diff -C1 -r 206b/recipes_f/recipes/chebft.f 208/recipes_f/recipes/chebft.f *** 206b/recipes_f/recipes/chebft.f Fri Sep 25 14:24:56 1992 --- 208/recipes_f/recipes/chebft.f Mon Jul 14 20:32:36 1997 *************** *** 2,4 **** INTEGER n,NMAX ! REAL a,b,c(n),func,PI EXTERNAL func --- 2,5 ---- INTEGER n,NMAX ! REAL a,b,c(n),func ! DOUBLE PRECISION PI EXTERNAL func *************** *** 11,13 **** do 11 k=1,n ! y=cos(PI*(k-0.5)/n) f(k)=func(y*bma+bpa) --- 12,14 ---- do 11 k=1,n ! y=cos(PI*(k-0.5d0)/n) f(k)=func(y*bma+bpa) diff -C1 -r 206b/recipes_f/recipes/dfpmin.f 208/recipes_f/recipes/dfpmin.f *** 206b/recipes_f/recipes/dfpmin.f Fri Sep 25 14:25:15 1992 --- 208/recipes_f/recipes/dfpmin.f Mon Jul 14 20:32:38 1997 *************** *** 66,68 **** 21 continue ! if(fac**2.gt.EPS*sumdg*sumxi)then fac=1./fac --- 66,68 ---- 21 continue ! if(fac.gt.sqrt(EPS*sumdg*sumxi))then fac=1./fac *************** *** 73,75 **** do 24 i=1,n ! do 23 j=1,n hessin(i,j)=hessin(i,j)+fac*xi(i)*xi(j)-fad*hdg(i)*hdg(j)+ --- 73,75 ---- do 24 i=1,n ! do 23 j=i,n hessin(i,j)=hessin(i,j)+fac*xi(i)*xi(j)-fad*hdg(i)*hdg(j)+ *************** *** 76,77 **** --- 76,78 ---- *fae*dg(i)*dg(j) + hessin(j,i)=hessin(i,j) 23 continue diff -C1 -r 206b/recipes_f/recipes/fit.f 208/recipes_f/recipes/fit.f *** 206b/recipes_f/recipes/fit.f Fri Sep 25 14:25:39 1992 --- 208/recipes_f/recipes/fit.f Mon Jul 14 20:32:40 1997 *************** *** 44,45 **** --- 44,46 ---- chi2=0. + q=1. if(mwt.eq.0) then *************** *** 48,50 **** 15 continue - q=1. sigdat=sqrt(chi2/(ndata-2)) --- 49,50 ---- *************** *** 56,58 **** 16 continue ! q=gammq(0.5*(ndata-2),0.5*chi2) endif --- 56,58 ---- 16 continue ! if(ndata.gt.2) q=gammq(0.5*(ndata-2),0.5*chi2) endif diff -C1 -r 206b/recipes_f/recipes/frprmn.f 208/recipes_f/recipes/frprmn.f *** 206b/recipes_f/recipes/frprmn.f Fri Sep 25 14:25:51 1992 --- 208/recipes_f/recipes/frprmn.f Mon Jul 14 20:32:43 1997 *************** *** 19,21 **** if(2.*abs(fret-fp).le.ftol*(abs(fret)+abs(fp)+EPS))return ! fp=func(p) call dfunc(p,xi) --- 19,21 ---- if(2.*abs(fret-fp).le.ftol*(abs(fret)+abs(fp)+EPS))return ! fp=fret call dfunc(p,xi) diff -C1 -r 206b/recipes_f/recipes/gasdev.f 208/recipes_f/recipes/gasdev.f *** 206b/recipes_f/recipes/gasdev.f Fri Sep 25 14:25:55 1992 --- 208/recipes_f/recipes/gasdev.f Mon Jul 14 20:32:43 1997 *************** *** 8,9 **** --- 8,10 ---- DATA iset/0/ + if (idum.lt.0) iset=0 if (iset.eq.0) then diff -C1 -r 206b/recipes_f/recipes/lnsrch.f 208/recipes_f/recipes/lnsrch.f *** 206b/recipes_f/recipes/lnsrch.f Fri Mar 19 01:12:00 1993 --- 208/recipes_f/recipes/lnsrch.f Mon Jul 14 20:32:46 1997 *************** *** 8,11 **** INTEGER i ! REAL a,alam,alam2,alamin,b,disc,f2,fold2,rhs1,rhs2,slope,sum,temp, ! *test,tmplam check=.false. --- 8,11 ---- INTEGER i ! REAL a,alam,alam2,alamin,b,disc,f2,rhs1,rhs2,slope,sum,temp,test, ! *tmplam check=.false. *************** *** 25,26 **** --- 25,27 ---- 13 continue + if(slope.ge.0.) pause 'roundoff problem in lnsrch' test=0. *************** *** 50,52 **** rhs1=f-fold-alam*slope ! rhs2=f2-fold2-alam2*slope a=(rhs1/alam**2-rhs2/alam2**2)/(alam-alam2) --- 51,53 ---- rhs1=f-fold-alam*slope ! rhs2=f2-fold-alam2*slope a=(rhs1/alam**2-rhs2/alam2**2)/(alam-alam2) *************** *** 57,60 **** disc=b*b-3.*a*slope ! if(disc.lt.0.) pause 'roundoff problem in lnsrch' ! tmplam=(-b+sqrt(disc))/(3.*a) endif --- 58,66 ---- disc=b*b-3.*a*slope ! if(disc.lt.0.)then ! tmplam=.5*alam ! else if(b.le.0.)then ! tmplam=(-b+sqrt(disc))/(3.*a) ! else ! tmplam=-slope/(b+sqrt(disc)) ! endif endif *************** *** 65,67 **** f2=f - fold2=fold alam=max(tmplam,.1*alam) --- 71,72 ---- diff -C1 -r 206b/recipes_f/recipes/miser.f 208/recipes_f/recipes/miser.f *** 206b/recipes_f/recipes/miser.f Fri Sep 25 14:26:40 1992 --- 208/recipes_f/recipes/miser.f Mon Jul 14 20:32:48 1997 *************** *** 9,12 **** REAL avel,fracl,fval,rgl,rgm,rgr,s,sigl,siglb,sigr,sigrb,sum,sumb, ! *summ,summ2,varl,fmaxl(10),fmaxr(10),fminl(10),fminr(10),pt(10), ! *rmid(10),stack(NSTACK),stf(9) EQUIVALENCE (stf(1),avel),(stf(2),varl),(stf(3),jb),(stf(4),nptr), --- 9,12 ---- REAL avel,fracl,fval,rgl,rgm,rgr,s,sigl,siglb,sigr,sigrb,sum,sumb, ! *summ,summ2,varl,fmaxl(MAXD),fmaxr(MAXD),fminl(MAXD),fminr(MAXD), ! *pt(MAXD),rmid(MAXD),stack(NSTACK),stf(9) EQUIVALENCE (stf(1),avel),(stf(2),varl),(stf(3),jb),(stf(4),nptr), diff -C1 -r 206b/recipes_f/recipes/mpdiv.f 208/recipes_f/recipes/mpdiv.f *** 206b/recipes_f/recipes/mpdiv.f Fri Sep 25 14:26:44 1992 --- 208/recipes_f/recipes/mpdiv.f Mon Jul 14 20:32:48 1997 *************** *** 3,12 **** CHARACTER*1 q(n-m+1),r(m),u(n),v(m) ! PARAMETER (NMAX=8192,MACC=3) ! CU USES mpinv,mpmov,mpmul,mpsub INTEGER is ! CHARACTER*1 rr(2*NMAX),s(NMAX) if(n+MACC.gt.NMAX)pause 'NMAX too small in mpdiv' ! call mpinv(s,v,n-m+MACC,m) ! call mpmul(rr,s,u,n-m+MACC,n) ! call mpmov(q,rr(2),n-m+1) call mpmul(rr,q,v,n-m+1,m) --- 3,13 ---- CHARACTER*1 q(n-m+1),r(m),u(n),v(m) ! PARAMETER (NMAX=8192,MACC=6) ! CU USES mpinv,mpmov,mpmul,mpsad,mpsub INTEGER is ! CHARACTER*1 rr(2*NMAX),s(2*NMAX) if(n+MACC.gt.NMAX)pause 'NMAX too small in mpdiv' ! call mpinv(s,v,n+MACC,m) ! call mpmul(rr,s,u,n+MACC,n) ! call mpsad(s,rr,n+n+MACC/2,1) ! call mpmov(q,s(3),n-m+1) call mpmul(rr,q,v,n-m+1,m) diff -C1 -r 206b/recipes_f/recipes/mrqmin.f 208/recipes_f/recipes/mrqmin.f *** 206b/recipes_f/recipes/mrqmin.f Wed Feb 02 09:01:45 1994 --- 208/recipes_f/recipes/mrqmin.f Mon Jul 14 20:32:49 1997 *************** *** 32,33 **** --- 32,34 ---- call covsrt(covar,nca,ma,ia,mfit) + call covsrt(alpha,nca,ma,ia,mfit) return diff -C1 -r 206b/recipes_f/recipes/powell.f 208/recipes_f/recipes/powell.f *** 206b/recipes_f/recipes/powell.f Fri Sep 25 14:27:05 1992 --- 208/recipes_f/recipes/powell.f Mon Jul 14 20:32:50 1997 *************** *** 2,6 **** INTEGER iter,n,np,NMAX,ITMAX ! REAL fret,ftol,p(np),xi(np,np),func EXTERNAL func ! PARAMETER (NMAX=20,ITMAX=200) CU USES func,linmin --- 2,6 ---- INTEGER iter,n,np,NMAX,ITMAX ! REAL fret,ftol,p(np),xi(np,np),func,TINY EXTERNAL func ! PARAMETER (NMAX=20,ITMAX=200,TINY=1.e-25) CU USES func,linmin *************** *** 23,26 **** call linmin(p,xit,n,fret) ! if(abs(fptt-fret).gt.del)then ! del=abs(fptt-fret) ibig=i --- 23,26 ---- call linmin(p,xit,n,fret) ! if(fptt-fret.gt.del)then ! del=fptt-fret ibig=i *************** *** 28,30 **** 13 continue ! if(2.*abs(fp-fret).le.ftol*(abs(fp)+abs(fret)))return if(iter.eq.ITMAX) pause 'powell exceeding maximum iterations' --- 28,30 ---- 13 continue ! if(2.*(fp-fret).le.ftol*(abs(fp)+abs(fret))+TINY)return if(iter.eq.ITMAX) pause 'powell exceeding maximum iterations' diff -C1 -r 206b/recipes_f/recipes/pwt.f 208/recipes_f/recipes/pwt.f *** 206b/recipes_f/recipes/pwt.f Fri Sep 25 14:27:07 1992 --- 208/recipes_f/recipes/pwt.f Mon Jul 14 20:32:50 1997 *************** *** 7,8 **** --- 7,9 ---- REAL ai,ai1 + SAVE /pwtcom/ if (n.lt.4) return diff -C1 -r 206b/recipes_f/recipes/qsimp.f 208/recipes_f/recipes/qsimp.f *** 206b/recipes_f/recipes/qsimp.f Wed Feb 02 09:01:46 1994 --- 208/recipes_f/recipes/qsimp.f Mon Jul 14 20:32:51 1997 *************** *** 13,16 **** s=(4.*st-ost)/3. ! if (abs(s-os).lt.EPS*abs(os)) return ! if (s.eq.0..and.os.eq.0..and.j.gt.6) return os=s --- 13,17 ---- s=(4.*st-ost)/3. ! if (j.gt.5) then ! if (abs(s-os).lt.EPS*abs(os).or.(s.eq.0..and.os.eq.0.)) return ! endif os=s diff -C1 -r 206b/recipes_f/recipes/qtrap.f 208/recipes_f/recipes/qtrap.f *** 206b/recipes_f/recipes/qtrap.f Wed Feb 02 09:01:46 1994 --- 208/recipes_f/recipes/qtrap.f Mon Jul 14 20:32:51 1997 *************** *** 11,14 **** call trapzd(func,a,b,s,j) ! if (abs(s-olds).lt.EPS*abs(olds)) return ! if (s.eq.0..and.olds.eq.0..and.j.gt.6) return olds=s --- 11,16 ---- call trapzd(func,a,b,s,j) ! if (j.gt.5) then ! if (abs(s-olds).lt.EPS*abs(olds).or.(s.eq.0..and.olds.eq.0.)) ! *return ! endif olds=s diff -C1 -r 206b/recipes_f/recipes/ran3.f 208/recipes_f/recipes/ran3.f *** 206b/recipes_f/recipes/ran3.f Fri Sep 25 14:27:21 1992 --- 208/recipes_f/recipes/ran3.f Mon Jul 14 20:32:51 1997 *************** *** 14,16 **** iff=1 ! mj=MSEED-iabs(idum) mj=mod(mj,MBIG) --- 14,16 ---- iff=1 ! mj=abs(MSEED-abs(idum)) mj=mod(mj,MBIG) diff -C1 -r 206b/recipes_f/recipes/rtsafe.f 208/recipes_f/recipes/rtsafe.f *** 206b/recipes_f/recipes/rtsafe.f Fri Sep 25 14:27:49 1992 --- 208/recipes_f/recipes/rtsafe.f Mon Jul 14 20:32:54 1997 *************** *** 29,31 **** do 11 j=1,MAXIT ! if(((rtsafe-xh)*df-f)*((rtsafe-xl)*df-f).ge.0..or. abs(2.* *f).gt.abs(dxold*df) ) then --- 29,31 ---- do 11 j=1,MAXIT ! if(((rtsafe-xh)*df-f)*((rtsafe-xl)*df-f).gt.0..or. abs(2.* *f).gt.abs(dxold*df) ) then diff -C1 -r 206b/recipes_f/recipes/simp1.f 208/recipes_f/recipes/simp1.f *** 206b/recipes_f/recipes/simp1.f Fri Sep 25 14:27:58 1992 --- 208/recipes_f/recipes/simp1.f Mon Jul 14 20:32:54 1997 *************** *** 5,19 **** REAL test ! kp=ll(1) ! bmax=a(mm+1,kp+1) ! do 11 k=2,nll ! if(iabf.eq.0)then ! test=a(mm+1,ll(k)+1)-bmax ! else ! test=abs(a(mm+1,ll(k)+1))-abs(bmax) ! endif ! if(test.gt.0.)then ! bmax=a(mm+1,ll(k)+1) ! kp=ll(k) ! endif ! 11 continue return --- 5,23 ---- REAL test ! if(nll.le.0)then ! bmax=0. ! else ! kp=ll(1) ! bmax=a(mm+1,kp+1) ! do 11 k=2,nll ! if(iabf.eq.0)then ! test=a(mm+1,ll(k)+1)-bmax ! else ! test=abs(a(mm+1,ll(k)+1))-abs(bmax) ! endif ! if(test.gt.0.)then ! bmax=a(mm+1,ll(k)+1) ! kp=ll(k) ! endif ! 11 continue ! endif return diff -C1 -r 206b/recipes_f/recipes/simp2.f 208/recipes_f/recipes/simp2.f *** 206b/recipes_f/recipes/simp2.f Fri Sep 25 14:28:01 1992 --- 208/recipes_f/recipes/simp2.f Mon Jul 14 20:32:54 1997 *************** *** 1,10 **** ! SUBROUTINE simp2(a,m,n,mp,np,l2,nl2,ip,kp,q1) ! INTEGER ip,kp,m,mp,n,nl2,np,l2(mp) ! REAL q1,a(mp,np),EPS PARAMETER (EPS=1.e-6) ! INTEGER i,ii,k ! REAL q,q0,qp ip=0 ! do 11 i=1,nl2 ! if(a(l2(i)+1,kp+1).lt.-EPS)goto 1 11 continue --- 1,10 ---- ! SUBROUTINE simp2(a,m,n,mp,np,ip,kp) ! INTEGER ip,kp,m,mp,n,np ! REAL a(mp,np),EPS PARAMETER (EPS=1.e-6) ! INTEGER i,k ! REAL q,q0,q1,qp ip=0 ! do 11 i=1,m ! if(a(i+1,kp+1).lt.-EPS)goto 1 11 continue *************** *** 11,20 **** return ! 1 q1=-a(l2(i)+1,1)/a(l2(i)+1,kp+1) ! ip=l2(i) ! do 13 i=i+1,nl2 ! ii=l2(i) ! if(a(ii+1,kp+1).lt.-EPS)then ! q=-a(ii+1,1)/a(ii+1,kp+1) if(q.lt.q1)then ! ip=ii q1=q --- 11,19 ---- return ! 1 q1=-a(i+1,1)/a(i+1,kp+1) ! ip=i ! do 13 i=ip+1,m ! if(a(i+1,kp+1).lt.-EPS)then ! q=-a(i+1,1)/a(i+1,kp+1) if(q.lt.q1)then ! ip=i q1=q *************** *** 23,25 **** qp=-a(ip+1,k+1)/a(ip+1,kp+1) ! q0=-a(ii+1,k+1)/a(ii+1,kp+1) if(q0.ne.qp)goto 2 --- 22,24 ---- qp=-a(ip+1,k+1)/a(ip+1,kp+1) ! q0=-a(i+1,k+1)/a(i+1,kp+1) if(q0.ne.qp)goto 2 *************** *** 26,28 **** 12 continue ! 2 if(q0.lt.qp)ip=ii endif --- 25,27 ---- 12 continue ! 2 if(q0.lt.qp)ip=i endif diff -C1 -r 206b/recipes_f/recipes/simplx.f 208/recipes_f/recipes/simplx.f *** 206b/recipes_f/recipes/simplx.f Mon Apr 24 20:02:47 1995 --- 208/recipes_f/recipes/simplx.f Mon Jul 14 20:32:55 1997 *************** *** 5,7 **** CU USES simp1,simp2,simp3 ! INTEGER i,ip,ir,is,k,kh,kp,m12,nl1,nl2,l1(NMAX),l2(MMAX),l3(MMAX) REAL bmax,q1 --- 5,7 ---- CU USES simp1,simp2,simp3 ! INTEGER i,ip,is,k,kh,kp,nl1,l1(NMAX),l3(MMAX) REAL bmax,q1 *************** *** 13,15 **** 11 continue - nl2=m do 12 i=1,m --- 13,14 ---- *************** *** 16,18 **** if(a(i+1,1).lt.0.)pause 'bad input tableau in simplx' - l2(i)=i iposv(i)=n+i --- 15,16 ---- *************** *** 19,20 **** --- 17,19 ---- 12 continue + if(m2+m3.eq.0)goto 30 do 13 i=1,m2 *************** *** 22,26 **** 13 continue - ir=0 - if(m2+m3.eq.0)goto 30 - ir=1 do 15 k=1,n+1 --- 21,22 ---- *************** *** 37,40 **** else if(bmax.le.EPS.and.a(m+2,1).le.EPS)then ! m12=m1+m2+1 ! do 16 ip=m12,m if(iposv(ip).eq.ip+n)then --- 33,35 ---- else if(bmax.le.EPS.and.a(m+2,1).le.EPS)then ! do 16 ip=m1+m2+1,m if(iposv(ip).eq.ip+n)then *************** *** 41,43 **** call simp1(a,mp,np,ip,l1,nl1,1,kp,bmax) ! if(bmax.gt.0.)goto 1 endif --- 36,38 ---- call simp1(a,mp,np,ip,l1,nl1,1,kp,bmax) ! if(bmax.gt.EPS)goto 1 endif *************** *** 44,48 **** 16 continue ! ir=0 ! m12=m12-1 ! do 18 i=m1+1,m12 if(l3(i-m1).eq.1)then --- 39,41 ---- 16 continue ! do 18 i=m1+1,m1+m2 if(l3(i-m1).eq.1)then *************** *** 55,57 **** endif ! call simp2(a,m,n,mp,np,l2,nl2,ip,kp,q1) if(ip.eq.0)then --- 48,50 ---- endif ! call simp2(a,m,n,mp,np,ip,kp) if(ip.eq.0)then *************** *** 70,81 **** else - if(iposv(ip).lt.n+m1+1)goto 20 kh=iposv(ip)-m1-n ! if(l3(kh).eq.0)goto 20 ! l3(kh)=0 endif ! a(m+2,kp+1)=a(m+2,kp+1)+1. ! do 22 i=1,m+2 ! a(i,kp+1)=-a(i,kp+1) ! 22 continue ! 20 is=izrov(kp) izrov(kp)=iposv(ip) --- 63,76 ---- else kh=iposv(ip)-m1-n ! if(kh.ge.1)then ! if(l3(kh).ne.0)then ! l3(kh)=0 ! a(m+2,kp+1)=a(m+2,kp+1)+1. ! do 22 i=1,m+2 ! a(i,kp+1)=-a(i,kp+1) ! 22 continue ! endif ! endif endif ! is=izrov(kp) izrov(kp)=iposv(ip) *************** *** 82,86 **** iposv(ip)=is ! if(ir.ne.0)goto 10 30 call simp1(a,mp,np,0,l1,nl1,0,kp,bmax) ! if(bmax.le.0.)then icase=0 --- 77,81 ---- iposv(ip)=is ! goto 10 30 call simp1(a,mp,np,0,l1,nl1,0,kp,bmax) ! if(bmax.le.EPS)then icase=0 *************** *** 88,90 **** endif ! call simp2(a,m,n,mp,np,l2,nl2,ip,kp,q1) if(ip.eq.0)then --- 83,85 ---- endif ! call simp2(a,m,n,mp,np,ip,kp) if(ip.eq.0)then *************** *** 94,96 **** call simp3(a,mp,np,m,n,ip,kp) ! goto 20 END --- 89,94 ---- call simp3(a,mp,np,m,n,ip,kp) ! is=izrov(kp) ! izrov(kp)=iposv(ip) ! iposv(ip)=is ! goto 30 END diff -C1 -r 206b/recipes_f/recipes/slvsm2.f 208/recipes_f/recipes/slvsm2.f *** 206b/recipes_f/recipes/slvsm2.f Fri Sep 25 14:28:05 1992 --- 208/recipes_f/recipes/slvsm2.f Mon Jul 14 20:32:55 1997 *************** *** 6,8 **** h=.5d0 ! fact=2./h**2 disc=sqrt(fact**2+rhs(2,2)) --- 6,8 ---- h=.5d0 ! fact=2.d0/h**2 disc=sqrt(fact**2+rhs(2,2)) diff -C1 -r 206b/recipes_f/recipes/sprstm.f 208/recipes_f/recipes/sprstm.f *** 206b/recipes_f/recipes/sprstm.f Fri Sep 25 14:28:24 1992 --- 208/recipes_f/recipes/sprstm.f Mon Jul 14 20:32:56 1997 *************** *** 13,15 **** else ! sum=0.d0 endif --- 13,15 ---- else ! sum=0.e0 endif diff -C1 -r 206b/recipes_f/recipes/vegas.f 208/recipes_f/recipes/vegas.f *** 206b/recipes_f/recipes/vegas.f Mon Apr 24 20:02:47 1995 --- 208/recipes_f/recipes/vegas.f Mon Jul 14 20:32:58 1997 *************** *** 22,26 **** if (init.le.1)then ! si=0. ! swgt=0. ! schi=0. endif --- 22,26 ---- if (init.le.1)then ! si=0.d0 ! swgt=0.d0 ! schi=0.d0 endif