55 lines
1.3 KiB
Fortran
55 lines
1.3 KiB
Fortran
SUBROUTINE GRIDP(X,Y,XNEW,YNEW,N)
|
|
c =================================
|
|
c
|
|
c evaluation of new grid points for a function; grid points
|
|
c determined by dividing the curve Y=f(x) into n-1 equal segments;
|
|
c the x-coordinates of the endpoints of the individual segments
|
|
c define new grid points
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
DIMENSION X(N),Y(N),XNEW(N),YNEW(N),Z(MDEPTH)
|
|
C
|
|
C original segments - lengths (Z), and directional cosines (CD);
|
|
C ZTOT - total length of the curve;
|
|
C Z0 - length of a new segment
|
|
C
|
|
ZTOT=0.
|
|
DO I=2,N
|
|
Z(I-1)=SQRT((X(I)-X(I-1))**2+(Y(I)-Y(I-1))**2)
|
|
ZTOT=ZTOT+Z(I-1)
|
|
END DO
|
|
Z0=ZTOT/(N-1)
|
|
C
|
|
ISEG=1
|
|
XLAST=X(ISEG)
|
|
YLAST=Y(ISEG)
|
|
ZREST=Z(ISEG)
|
|
ZREM=Z0
|
|
IP=1
|
|
XNEW(IP)=X(1)
|
|
YNEW(IP)=Y(1)
|
|
C
|
|
20 CONTINUE
|
|
IF(ZREM.LT.ZREST) THEN
|
|
ZREST=ZREST-ZREM
|
|
XLAST=XLAST+ZREM*(X(ISEG+1)-X(ISEG))/Z(ISEG)
|
|
YLAST=YLAST+ZREM*(Y(ISEG+1)-Y(ISEG))/Z(ISEG)
|
|
IP=IP+1
|
|
XNEW(IP)=XLAST
|
|
YNEW(IP)=YLAST
|
|
ZREM=Z0
|
|
IF(IP.GE.N-1) GO TO 50
|
|
ELSE
|
|
ZREM=ZREM-ZREST
|
|
ISEG=ISEG+1
|
|
XLAST=X(ISEG)
|
|
YLAST=Y(ISEG)
|
|
ZREST=Z(ISEG)
|
|
END IF
|
|
GO TO 20
|
|
50 XNEW(N)=X(N)
|
|
YNEW(N)=Y(N)
|
|
RETURN
|
|
END
|