diff -Nurd -x'*~' gracegtk-0.9.5.orig/contours/Makefile gracegtk-0.9.5/contours/Makefile --- gracegtk-0.9.5.orig/contours/Makefile 2011-06-16 06:34:46.000000000 -0400 +++ gracegtk-0.9.5/contours/Makefile 2019-11-07 02:52:16.000000000 -0500 @@ -21,7 +21,7 @@ CFLAGS = -g -Wall # Computing level sets can take time, so we use -O2 FFLAGS = -O2 -# FFLAGS = -g +# FFLAGS = -g -Wall LD=$(CC) diff -Nurd -x'*~' gracegtk-0.9.5.orig/contours/toms626_modified.f gracegtk-0.9.5/contours/toms626_modified.f --- gracegtk-0.9.5.orig/contours/toms626_modified.f 2011-12-03 03:48:24.000000000 -0500 +++ gracegtk-0.9.5/contours/toms626_modified.f 2019-11-07 02:52:16.000000000 -0500 @@ -312,7 +312,8 @@ 100 CONTINUE TS2(II)= 1.d0 DO 120 J=1,II - 120 TS1(J,KSE)= TS2(J) + TS1(J,KSE)= TS2(J) + 120 end do I= II 150 CONTINUE C IN(KSE)= NUMBER OF INTERVALS diff -Nurd -x'*~' gracegtk-0.9.5.orig/loess/Makefile gracegtk-0.9.5/loess/Makefile --- gracegtk-0.9.5.orig/loess/Makefile 2012-03-09 11:39:42.000000000 -0500 +++ gracegtk-0.9.5/loess/Makefile 2019-11-07 02:53:26.000000000 -0500 @@ -20,8 +20,8 @@ # FCFLAGS = -g -Wall # Computing level sets can take time, so we use -O2 # FFFLAGS = -O2 -FFLAGS = -g -CFLAGS = -g +FFLAGS = -g -Wall -Wno-unused-dummy-argument +CFLAGS = -g -Wall -I../src LD=$(CC) diff -Nurd -x'*~' gracegtk-0.9.5.orig/loess/loess.c gracegtk-0.9.5/loess/loess.c --- gracegtk-0.9.5.orig/loess/loess.c 2012-03-06 05:04:30.000000000 -0500 +++ gracegtk-0.9.5/loess/loess.c 2019-11-07 02:52:17.000000000 -0500 @@ -23,7 +23,6 @@ void EHG182_FC (Sint *i); static char *surf_stat; -static int errnum = 0; /** GraceGTK change: diff -Nurd -x'*~' gracegtk-0.9.5.orig/loess/loessc.c gracegtk-0.9.5/loess/loessc.c --- gracegtk-0.9.5.orig/loess/loessc.c 2012-02-27 04:10:20.000000000 -0500 +++ gracegtk-0.9.5/loess/loessc.c 2019-11-07 02:52:33.000000000 -0500 @@ -4,6 +4,7 @@ #include "../config.h" #include "S.h" +#include "utils.h" #define min(x,y) ((x) < (y) ? (x) : (y)) #define max(x,y) ((x) > (y) ? (x) : (y)) diff -Nurd -x'*~' gracegtk-0.9.5.orig/loess/loessf.f gracegtk-0.9.5/loess/loessf.f --- gracegtk-0.9.5.orig/loess/loessf.f 2012-03-06 11:28:22.000000000 -0500 +++ gracegtk-0.9.5/loess/loessf.f 2022-01-30 21:33:52.000000000 -0500 @@ -50,7 +50,7 @@ j=i-1 do 6 k=1,d v(i,k)=v(1+mod(j,2)*(vc-1),k) - j=DFLOAT(j)/2.D0 + j = INT( DFLOAT(j)/2.D0 ) 6 continue 5 continue return @@ -284,8 +284,8 @@ 8 continue end if if(dabs(w(idamax(nf,w,1))).eq.0)then - call ehg184('at ',q,dd,1) - call ehg184('radius ',rho,1,1) + call ehg1840('at ',q,dd) + print * ,'radius ',rho if(.not..false.)then call ehg182(121) RETURN @@ -378,9 +378,9 @@ PRINT *,'d =' ,d PRINT *,'q =' ,q - call ehg184('Warning. pseudoinverse used at ' ,q ,d ,1) - call ehg184('neighborhood radius',dsqrt(rho),1,1) - call ehg184('reciprocal condition number ',rcond,1,1) + call ehg1840 ('Warning. pseudoinverse used at ' ,q ,d) + print * ,'neighborhood radius',dsqrt(rho) + print * ,',reciprocal condition number ',rcond else if(sing.eq.2)then call ehg184('There are other near singularities as well.' @@ -519,12 +519,11 @@ +930370d0 / if(deg.eq.0) dk=1 if(deg.eq.1) dk=d+1 - if(deg.eq.2) dk=dfloat((d+2)*(d+1))/2.d0 + if(deg.eq.2) dk = INT (dfloat((d+2)*(d+1))/2.d0 ) corx=dsqrt(k/dfloat(n)) z=(dsqrt(k/trl)-corx)/(1-corx) - if(nsing .eq. 0 .and. 1 .lt. z) call ehg184('Chernobyl! trLn',trl,1,1) + if(nsing .eq. 0 .and. 1 .lt. z) print * ,'Chernobyl! trLn',trl z=min(1.0d0,max(0.0d0,z)) c R fix zz(1)=z @@ -836,7 +835,7 @@ REAL(8) g1 dk = 0 if(deg.eq.1) dk=d+1 - if(deg.eq.2) dk=dfloat((d+2)*(d+1))/2.d0 + if(deg.eq.2) dk = INT( dfloat((d+2)*(d+1))/2.d0 ) g1 = (-0.08125d0*d+0.13d0)*d+1.05d0 trl = dk*(1+max(0.d0,(g1-f)/f)) return @@ -898,7 +897,6 @@ t(nt)=i1 if(.not.(nt.lt.20))then call ehg182(181) - RETURN end if j=t(nt) goto 3 @@ -916,11 +914,11 @@ do 7 i=d,1,-1 h=(z(i)-v(ll,i))/(v(ur,i)-v(ll,i)) if(h.lt.-.001D0)then - call ehg184('eval ',z,d,1) + call ehg1840('eval ',z,d) call ehg184('lowerlimit ',v(ll,1),d,nvmax) else if(1.001D0.lt.h)then - call ehg184('eval ',z,d,1) + call ehg1840('eval ',z,d) call ehg184('upperlimit ',v(ur,1),d,nvmax) end if end if @@ -931,9 +929,8 @@ end if if(.not.i2)then call ehg182(122) - RETURN end if - lg=DFLOAT(lg)/2.D0 + lg = INT( DFLOAT(lg)/2.D0 ) do 8 ig=1,lg c Hermite basis phi0=(1-h)**2*(1+2*h) @@ -1204,19 +1201,21 @@ sew=phi0*gw+phi1*ge+(psi0*gpw+psi1*gpe)*(v(ur,1)-v(ll,1)) s=(sns+sew)-s end if - ehg128=s + ehg128 = s return end + integer function ifloor(x) DOUBLE PRECISION x - ifloor=x + ifloor = INT (x) if(ifloor.gt.x) ifloor=ifloor-1 end - DOUBLE PRECISION functionDSIGN(a1,a2) - DOUBLE PRECISION a1, a2 - DSIGN=DABS(a1) - if(a2.ge.0)DSIGN=-DSIGN - end + +!! DOUBLE PRECISION functionDSIGN(a1,a2) +!! DOUBLE PRECISION a1, a2 +!! DSIGN=DABS(a1) +!! if(a2.ge.0)DSIGN=-DSIGN +!! end c subroutine ehg136(u,lm,m,n,d,nf,f,x,psi,y,rw,kernel,k,dist,eta,b,o +d,o,ihat,w,rcond,sing,dd,tdeg,cdeg,s) @@ -1419,7 +1418,7 @@ call ehg137(z ,leaf,nleaf,d,ncmax ,a,xi,lo ,hi) do 12 ileaf=1,nleaf do 13 ii=lo(leaf(ileaf)),hi(leaf(ileaf)) - i=phi(pi(ii)) + i = INT( phi(pi(ii)) ) if(i.ne.0)then if(.not.(psi(i).eq.pi(ii)))then call ehg182(194) @@ -1645,7 +1644,7 @@ i1=d+1 else if(ideg.eq.2)then - i1=dfloat((d+2)*(d+1))/2.d0 + i1 = INT (dfloat((d+2)*(d+1))/2.d0 ) end if end if end if @@ -1971,7 +1970,7 @@ if(.not.leaf)then call ehg129(l,u,dd,x,pi,n,sigma) k=IDAMAX(dd,sigma,1) - m=DFLOAT(l+u)/2.D0 + m = INT( DFLOAT(l+u)/2.D0 ) call ehg106(l,u,m,1,x(1,k),pi,n) c bug fix from btyner@gmail.com 2006-07-20 @@ -2113,3 +2112,12 @@ end if return end +c +c from gracegtk-1.2.2 loess/loessf.f90 + subroutine ehg1840 (s,x,n) + implicit none + character*(*) s + integer n, j + double precision x(n) + print *,s,(x(j),j=1,n) + end subroutine ehg1840 diff -Nurd -x'*~' gracegtk-0.9.5.orig/loess/supp.f gracegtk-0.9.5/loess/supp.f --- gracegtk-0.9.5.orig/loess/supp.f 2012-02-24 07:30:56.000000000 -0500 +++ gracegtk-0.9.5/loess/supp.f 2019-11-07 02:52:17.000000000 -0500 @@ -34,7 +34,8 @@ DOUBLE PRECISION v(nvmax,d),xi(nc),vval(0:d,nv) write(iunit,*)d,nc,nv do 10 i=1,d -10 write(iunit,*)v(1,i),v(vc,i) + write(iunit,*)v(1,i),v(vc,i) + 10 end do j = 0 do 20 i=1,nc if(a(i).ne.0)then @@ -42,9 +43,10 @@ else write(iunit,*)a(i),j end if -20 continue + 20 end do do 30 i=1,nv -30 write(iunit,*)(vval(j,i),j=0,d) + write(iunit,*)(vval(j,i),j=0,d) + 30 end do end subroutine lohead(iunit,d,vc,nc,nv) @@ -91,18 +93,21 @@ +)),iv(iv(9)),iv(iv(10))) return end -c +c subroutine ehg168(iunit,d,vc,nc,nv,nvmax,v,a,xi,vval) IMPLICIT NONE INTEGER nvmax integer iunit,d,vc,nc,nv,a(nc),i,j DOUBLE PRECISION v(nvmax,d),xi(nc),vval(0:d,nv) do 10 i=1,d -10 read(iunit,*)v(1,i),v(vc,i) + read(iunit,*)v(1,i),v(vc,i) + 10 end do do 20 i=1,nc -20 read(iunit,*)a(i),xi(i) + read(iunit,*)a(i),xi(i) + 20 end do do 30 i=1,nv -30 read(iunit,*)(vval(j,i),j=0,d) + read(iunit,*)(vval(j,i),j=0,d) + 30 end do end c subroutine ehg170(k,d,vc,nv,nvmax,nc,ncmax,a,c,hi,lo,v,vval,xi) @@ -130,31 +135,31 @@ 53 format(' double precision v(',i5,',',i2,')') 54 format(' double precision vval(0:',i2,',',i5,')') 55 format(' double precision xi(',i5,')') -56 format(' double precision ehg128') -57 format(' data d,vc,nv,nc /',i2,',',i3,',',i5,',',i5,'/') + 56 format(' double precision ehg128') + 57 format(' data d,vc,nv,nc /',i2,',',i3,',',i5,',',i5,'/') do 3 i=1,nc - write(k,58)i,a(i) -58 format(' data a(',i5,') /',i5,'/') - if(a(i).ne.0)then - write(k,59)i,i,i,hi(i),lo(i),xi(i) -59 format(' data hi(',i5,'),lo(',i5,'),xi(',i5,') /', - $ i5,',',i5,',',1pe15.6,'/') - end if - do 4 j=1,vc - write(k,60)j,i,c(j,i) -60 format(' data c(',i3,',',i5,') /',i5,'/') - 4 continue - 3 continue + write(k,58)i,a(i) + 58 format(' data a(',i5,') /',i5,'/') + if(a(i).ne.0)then + write(k,59)i,i,i,hi(i),lo(i),xi(i) + 59 format(' data hi(',i5,'),lo(',i5,'),xi(',i5,') /', + $ i5,',',i5,',',1pe15.6,'/') + end if + do 4 j=1,vc + write(k,60)j,i,c(j,i) + 60 format(' data c(',i3,',',i5,') /',i5,'/') + 4 end do + 3 end do do 5 i=1,nv - write(k,61)i,vval(0,i) -61 format(' data vval(0,',i5,') /',1pe15.6,'/') - do 6 j=1,d - write(k,62)i,j,v(i,j) -62 format(' data v(',i5,',',i2,') /',1pe15.6,'/') - write(k,63)j,i,vval(j,i) -63 format(' data vval(',i2,',',i5,') /',1pe15.6,'/') - 6 continue - 5 continue + write(k,61)i,vval(0,i) + 61 format(' data vval(0,',i5,') /',1pe15.6,'/') + do 6 j=1,d + write(k,62)i,j,v(i,j) + 62 format(' data v(',i5,',',i2,') /',1pe15.6,'/') + write(k,63)j,i,vval(j,i) + 63 format(' data vval(',i2,',',i5,') /',1pe15.6,'/') + 6 end do + 5 end do write(k,*)' loeval=ehg128(z,d,nc,vc,a,xi,lo,hi,c,v,nv,vval)' write(k,*)' end' return