V3FIT
pack.f
1  SUBROUTINE packk(gp,xp,yp,mp,delta)
2 c-----------------------------------------------------------------------
3 c the INTerpolation and extrapolation routines are inaccurate IF some of
4 c points found by furplm are too CLOSE together. this routine chooses
5 c subset of those points which are well spaced and redefines the arrays
6 c gr and drp to apply ONLY to these points.
7 c last changes made july 2 by fjh
8 c-----------------------------------------------------------------------
9  USE precision
10  IMPLICIT NONE
11  REAL(rprec) :: xp(*),yp(*),gp(*)
12  REAL(rprec) :: xs, ys, d, dd, delta
13  INTEGER :: mp1, mpi, i, mp, i1, j
14  mp1=mp-1
15  mpi=mp1
16  dd=delta*delta
17  DO 1 i=1,mp1
18  IF (i.gt.mpi) GOTO 3
19 6 xs=(xp(i+1)-xp(i))**2
20  ys=(yp(i+1)-yp(i))**2
21  d=xs+ys
22  IF (d.ge.dd) GOTO 1
23  IF (i.eq.mpi) GOTO 4
24  i1=i+1
25  DO j=i1,mpi
26  gp(j)=gp(j+1)
27  xp(j)=xp(j+1)
28  yp(j)=yp(j+1)
29  END DO
30  mpi=mpi-1
31  GOTO 6
32 1 CONTINUE
33 3 mp=mpi+1
34  GOTO 7
35 4 xp(mpi)=xp(mpi+1)
36  yp(mpi)=yp(mpi+1)
37  gp(mpi)=gp(mpi+1)
38  mp=mpi
39  7 DO 10 i=1,mp
40  gp(i)=abs(gp(i))
41  10 CONTINUE
42  END SUBROUTINE packk
Generated on Thu Mar 5 2020 15:49:23 for V3FIT by   doxygen 1.8.17