PROCEDURE DELHEAP;
    VAR
      X:INTEGER;
      Z:A;
    PROCEDURE READOUT(VAR P:A);
      VAR
        I:INTEGER;
      PROCEDURE SUBREAD(VAR Q:A);
        BEGIN
          NEW(Q);
          READ(Q^.C);
          IF Q^.C=0
            THEN Q:=NIL
            ELSE
              BEGIN
                SUBREAD(Q^.D);
                SUBREAD(Q^.E);
              END
        END;
      BEGIN
        NEW(P);
        ROOT:=P;
        READ(P^.C);
        IF P^.C<>0
          THEN
            BEGIN
              SUBREAD(P^.D);
              SUBREAD(P^.E)
            END;
        READLN(MAX);
        FOR I:=1 TO MAX DO
          READ(KEY[ I ]);
        WRITELN;
        FOR I := 1 TO MAX DO
          WRITE( KEY[ I ] :4);
        WRITELN
      END;
    BEGIN (*DELHEAP*)
      READOUT(P);
      X:=KEY[ ROOT^.C ];
      K:=KEY[ MAX ];
      MAX:=MAX-1;
      P:=ROOT;
      BOOL:=TRUE;
      WHILE(P<>NIL) AND BOOL DO
        BEGIN
          WITH P^ DO
             IF KEY[ D^.C ] < KEY[ E^.C ]
             THEN
                BEGIN
                  M:= E^.C;
                  Z := E
                END
             ELSE
                BEGIN
                  M:= D^.C;
                  Z:= D
                END;
                IF K < KEY[ M ]
                THEN
                  BEGIN
                    KEY[ P^.C ] := KEY[ M ] ;
                    P := Z
                  END
                ELSE BOOL := FALSE
      END ;
    KEY[ P^.C ] := K
  END ;