SUBROUTINE SMOOTH( X, Y, N, ICOL, ISYM, ISIZE, INUM, LINTYP ) LOGICAL STARTINEW, DRAWILINE, DRAWIMARK, INSIDE, INX0, INX LOGICAL VALID DIMENSION X(N), Y(N) COMMON /HSCALE/ XSLOPE, XCONST, YSLOPE, YCONST COMMON /WORLD/ XMIN, XMAX, YMIN, YMAX COMMON /CHKBON/ INSIDE, STARTINEW, LINNYP, LIN1, DASH DATA DYX / .5 / VALID = N .GE. 3 IF(.NOT.( VALID )) GO TO 32759 H0 = X(2) - X(1) DO 32758 I = 3, N H1 = X(I) - X(I-1) VALID = VALID .AND. ( H0 * H1 .GT. 0 ) 32758 CONTINUE 32759 IF(.NOT.( VALID )) GO TO 32756 DRAWILINE = INUM .GE. 0 DRAWIMARK = ISIZE .GE. 1 .AND. ISIZE .LE. 5 DRAWIMARK = DRAWIMARK .AND. ISYM .GE. 0 .AND. ISYM .LE. 5 DRAWIMARK = DRAWIMARK .AND. INUM .NE. 0 IF(.NOT.( DRAWILINE )) GO TO 32755 STARTINEW = .TRUE. CALL COLTYP(ICOL) OPEN( UNIT=1, TYPE='SCRATCH' ) DO 32754 I = 1, N WRITE(1,*) X(I), Y(I) 32754 CONTINUE REWIND 1 H0 = X(2) - X(1) Y0 = 6 * ( Y(2) - Y(1) ) / H0 FAC = 0. DO 32753 I = 2, N-1 H1 = X(I+1) - X(I) X(I) = ( 2 * ( H1 + H0 ) - FAC ) / H1 Y1 = 6 * ( Y(I+1) - Y(I) ) / H1 Y(I) = ( Y1 - Y0 - Y(I-1) * FAC ) / H1 Y0 = Y1 H0 = H1 FAC = H0 / X(I) 32753 CONTINUE Y(1) = 0. Y(N) = 0. DO 32752 I = N-1, 2, -1 Y(I) = ( Y(I) - Y(I+1) ) / X(I) 32752 CONTINUE C0 = Y(1) READ(1,*) X(1), Y(1) CALL MOVETO( X(1), Y(1), 0, LINTYP ) INX0 = ( X(1) - XMIN ) * ( XMAX - X(1) ) .GE. 0. DO 32751 I = 2, N C1 = Y(I) READ(1,*) X(I), Y(I) INX = ( X(I) - XMIN ) * ( XMAX - X(I) ) .GE. 0. H = X(I) - X(I-1) B = Y(I) / H - C1 * H / 6. D = Y(I-1) / H - C0 * H / 6. SQR = SQRT( ( C0 * C0 + C1 * C1 + C0 * C1 ) * 3. ) ANUM = C1 + 2 * C0 ADEN = 3 * C0 + SQR DY = 0. DC = C1 - C0 IF(.NOT.( ANUM*ADEN .GT. 0. .AND. ANUM*ADEN .LT. ADEN*ADEN )) GO T 1O 32750 DX = ANUM / ADEN DY = ABS( DX * (( DC * DX + 3 * C0 ) * DX - ANUM ) ) 32750 ADEN = 3 * C0 - SQR IF(.NOT.( ANUM*ADEN .GT. 0. .AND. ANUM*ADEN .LT. ADEN*ADEN )) GO T 1O 32749 DX = ANUM / ADEN DY1 = ABS( DX * (( DC * DX + 3 * C0 ) * DX - ANUM ) ) DY = AMAX1( DY, DY1 ) 32749 DY = ABS( YSLOPE * H * H * DY / 6. ) IF(.NOT.( DY .GE. DYX .AND. ( INX0 .OR. INX ) )) GO TO 32748 NN = DY / DYX + 1 DO 32747 J = 1, NN - 1 XI0 = ( H * J ) / NN XI = XI0 + X(I-1) XI1 = H - XI0 YI = XI0 * ( C1 * XI0 * XI0 / ( 6 * H ) + B ) YI = YI + XI1 * ( C0 * XI1 * XI1 / ( 6 * H ) + D ) CALL MOVETO( XI, YI, 1, LINTYP ) 32747 CONTINUE 32748 INX0 = INX C0 = C1 CALL MOVETO( X(I), Y(I), 1, LINTYP ) 32751 CONTINUE CLOSE ( UNIT=1 ) 32755 IF(.NOT.( DRAWIMARK )) GO TO 32746 STARTINEW = .TRUE. ITEMP = IABS(INUM) CALL COLTYP(ICOL) DO 32745 I = 1, N, ITEMP CALL MOVETO( X(I), Y(I), 0, LINTYP ) IF ( INSIDE ) CALL MARKER( ISYM, ISIZE ) 32745 CONTINUE 32746 GO TO 32757 32756 CALL DASHLN( X, Y, N, ICOL, ISYM, ISIZE, INUM, LINTYP ) 32757 RETURN END