procedure MIDEXP(AA,BB:real; var S:real;N:integer);
var
      IT,J:integer;  A,B,DEL,DDEL,SUM,TNM,X:real;
begin
      FUNC(X)=FUNK(-ALn(X))/X;
      B:= EXP(-AA);
      A:= 0.0;
      IF N = 1 THEN
      begin
          S:=(B-A)*FUNC(0.5*(A+B));
          IT:= 1;
      end
      ELSE
      begin
          TNM:= IT;
          DEL:=(B - A)/(3. * TNM);
          DDEL:= DEL + DEL;
          X:= A + 0.5*DEL;
          SUM:= 0.0;
          For J:=1 To IT do
          begin
              SUM:= SUM + FUNC(X);
              X:= X + DDEL;
              SUM:= SUM + FUNC(X);
              X:= X + DEL;
          end;
          S:= (S + (B-A) * SUM/TNM) / 3.0;
          IT:= 3 * IT;
      end;
  end;