code 41500;
real procedure PHI(X); value X; real X;
begin real ABSX, ERF, ERFC, C, P, Q;
    X:= X × .70710 67811 8655; ABSX:= ABS(X);
    if X > 5.5 then PHI:= 1 else if X < -5.5
    then PHI:= 0 else if ABSX ≤ 0.5 then
    begin C:= X × X;
          P:= ((-0.35609 84370 181510-1 × C +
          0.69963 83488 619110+1) × C + 0.21979 26161 829410+2)
          × C + 0.24266 79552 305310+3;
          Q:= ((C +
          0.15082 79763 040810+2) × C +
          0.91164 90540 451510+2) × C +
          0.21505 88758 698610+3;
          PHI:= .5 × X × P / Q + .5
      end else
      begin if ABSX < 4 then
          begin C:= ABSX;
             P:= ((((((-0.13686 48573 827210-6 × C +
             0.56419 55174 789710+0) × C +
             0.72117 58250 883110+1) × C +
             0.43162 22722 205710+2) × C +
             0.15298 92850 469410+3) × C +
             0.33932 08167 343410+3) × C +
             0.45191 89537 118710+3) × C +
             0.30045 92610 201610+3;
             Q:= ((((((C +
             0.12782 72731 962910+2) × C +
             0.77000 15293 523010+2) × C +
             0.27758 54447 439910+3) × C +
             0.63898 02644 656310+3) × C +
             0.93135 40948 306110+3) × C +
             0.79095 09253 279010+3) × C +
             0.30045 92609 369810+3;
              C:= P/Q
          end else
          begin C:= 1 / X / X;
              P:= (((0.22319 24597 341910-1 × C +
              0.27866 13086 096510-0) × C +
              0.22695 65935 396910-0) × C +
              0.49473 09106 232510-1) × C +
              0.29961 07077 035410-2;
              Q:= (((C +
              0.19873 32018 171410+1) × C +
              0.10516 75107 067910+1) × C +
              0.19130 89261 078310+0) × C +
              0.10620 92305 284710-1;
              C:= (C × (-P) / Q + 0.56418 95835 4776) / ABSX
          end;
          PHI:= .5 + .5 × SIGN(X) × (1 - C × EXP(-X × X))
     end
end PHI;
eop