2933
2934
2935
2936
2937
2938
2939
2940 INTEGER INCX, INCY, N
2941 REAL ERRBND, PREC, SCLR
2942
2943
2944 REAL X( * ), Y( * )
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006 REAL ONE, TWO, ZERO
3007 parameter( one = 1.0e+0, two = 2.0e+0,
3008 $ zero = 0.0e+0 )
3009
3010
3011 INTEGER I, IX, IY
3012 REAL ADDBND, FACT, SUMNEG, SUMPOS, TMP
3013
3014
3016
3017
3018
3019 ix = 1
3020 iy = 1
3021 sclr = zero
3022 sumpos = zero
3023 sumneg = zero
3024 fact = two * ( one + prec )
3025 addbnd = two * two * two * prec
3026
3027 DO 10 i = 1, n
3028 tmp = x( ix ) * y( iy )
3029 sclr = sclr + tmp
3030 IF( tmp.GE.zero ) THEN
3031 sumpos = sumpos + tmp * fact
3032 ELSE
3033 sumneg = sumneg - tmp * fact
3034 END IF
3035 ix = ix + incx
3036 iy = iy + incy
3037 10 CONTINUE
3038
3039 errbnd = addbnd *
max( sumpos, sumneg )
3040
3041 RETURN
3042
3043
3044