SUBROUTINE PCHCI (N, H, SLOPE, D, INCFD) C C Programming notes: C 1. The function PCHST(ARG1,ARG2) is assumed to return zero if C either argument is zero, +1 if they are of the same sign, and C -1 if they are of opposite sign. C**End C C DECLARE ARGUMENTS. C INTEGER N, INCFD REAL H(*), SLOPE(*), D(INCFD,*) C C DECLARE LOCAL VARIABLES. C INTEGER I, NLESS1 REAL DEL1, DEL2, DMAX, DMIN, DRAT1, DRAT2, HSUM, HSUMT3, THREE, * W1, W2, ZERO SAVE ZERO, THREE REAL PCHST C C INITIALIZE. C DATA ZERO /0./, THREE /3./ C***FIRST EXECUTABLE STATEMENT PCHCI NLESS1 = N - 1 DEL1 = SLOPE(1) C C SPECIAL CASE N=2 -- USE LINEAR INTERPOLATION. C IF (NLESS1 .GT. 1) GO TO 10 D(1,1) = DEL1 D(1,N) = DEL1 GO TO 5000 C C NORMAL CASE (N .GE. 3). C 10 CONTINUE DEL2 = SLOPE(2) C C SET D(1) VIA NON-CENTERED THREE-POINT FORMULA, ADJUSTED TO BE C SHAPE-PRESERVING. C HSUM = H(1) + H(2) W1 = (H(1) + HSUM)/HSUM W2 = -H(1)/HSUM D(1,1) = W1*DEL1 + W2*DEL2 IF ( PCHST(D(1,1),DEL1) .LE. ZERO) THEN D(1,1) = ZERO ELSE IF ( PCHST(DEL1,DEL2) .LT. ZERO) THEN C NEED DO THIS CHECK ONLY IF MONOTONICITY SWITCHES. DMAX = THREE*DEL1 IF (ABS(D(1,1)) .GT. ABS(DMAX)) D(1,1) = DMAX ENDIF C C LOOP THROUGH INTERIOR POINTS. C DO 50 I = 2, NLESS1 IF (I .EQ. 2) GO TO 40 C HSUM = H(I-1) + H(I) DEL1 = DEL2 DEL2 = SLOPE(I) 40 CONTINUE C C SET D(I)=0 UNLESS DATA ARE STRICTLY MONOTONIC. C D(1,I) = ZERO IF ( PCHST(DEL1,DEL2) .LE. ZERO) GO TO 50 C C USE BRODLIE MODIFICATION OF BUTLAND FORMULA. C HSUMT3 = HSUM+HSUM+HSUM W1 = (HSUM + H(I-1))/HSUMT3 W2 = (HSUM + H(I) )/HSUMT3 DMAX = MAX( ABS(DEL1), ABS(DEL2) ) DMIN = MIN( ABS(DEL1), ABS(DEL2) ) DRAT1 = DEL1/DMAX DRAT2 = DEL2/DMAX D(1,I) = DMIN/(W1*DRAT1 + W2*DRAT2) C 50 CONTINUE C C SET D(N) VIA NON-CENTERED THREE-POINT FORMULA, ADJUSTED TO BE C SHAPE-PRESERVING. C W1 = -H(N-1)/HSUM W2 = (H(N-1) + HSUM)/HSUM D(1,N) = W1*DEL1 + W2*DEL2 IF ( PCHST(D(1,N),DEL2) .LE. ZERO) THEN D(1,N) = ZERO ELSE IF ( PCHST(DEL1,DEL2) .LT. ZERO) THEN C NEED DO THIS CHECK ONLY IF MONOTONICITY SWITCHES. DMAX = THREE*DEL2 IF (ABS(D(1,N)) .GT. ABS(DMAX)) D(1,N) = DMAX ENDIF C C NORMAL RETURN. C 5000 CONTINUE RETURN C------------- LAST LINE OF PCHCI FOLLOWS ------------------------------ END