V3FIT
GTOVMI
Sources
Map
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
1.8.17