3138
3139
3140
3141
3142
3143
3144
3145 INTEGER INCX, INCY, N
3146 REAL ERRBND, PREC
3147 COMPLEX SCLR
3148
3149
3150 COMPLEX X( * ), Y( * )
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212 REAL ONE, TWO, ZERO
3213 parameter( one = 1.0e+0, two = 2.0e+0,
3214 $ zero = 0.0e+0 )
3215
3216
3217 INTEGER I, IX, IY
3218 REAL ADDBND, FACT, SUMINEG, SUMIPOS, SUMRNEG,
3219 $ SUMRPOS, TMP
3220
3221
3222 INTRINSIC abs, aimag,
max, real
3223
3224
3225
3226 ix = 1
3227 iy = 1
3228 sclr = zero
3229 sumipos = zero
3230 sumineg = zero
3231 sumrpos = zero
3232 sumrneg = zero
3233 fact = two * ( one + prec )
3234 addbnd = two * two * two * prec
3235
3236 DO 10 i = 1, n
3237
3238 sclr = sclr + x( ix ) * y( iy )
3239
3240 tmp = real( x( ix ) ) * real( y( iy ) )
3241 IF( tmp.GE.zero ) THEN
3242 sumrpos = sumrpos + tmp * fact
3243 ELSE
3244 sumrneg = sumrneg - tmp * fact
3245 END IF
3246
3247 tmp = - aimag( x( ix ) ) * aimag( y( iy ) )
3248 IF( tmp.GE.zero ) THEN
3249 sumrpos = sumrpos + tmp * fact
3250 ELSE
3251 sumrneg = sumrneg - tmp * fact
3252 END IF
3253
3254 tmp = aimag( x( ix ) ) * real( y( iy ) )
3255 IF( tmp.GE.zero ) THEN
3256 sumipos = sumipos + tmp * fact
3257 ELSE
3258 sumineg = sumineg - tmp * fact
3259 END IF
3260
3261 tmp = real( x( ix ) ) * aimag( y( iy ) )
3262 IF( tmp.GE.zero ) THEN
3263 sumipos = sumipos + tmp * fact
3264 ELSE
3265 sumineg = sumineg - tmp * fact
3266 END IF
3267
3268 ix = ix + incx
3269 iy = iy + incy
3270
3271 10 CONTINUE
3272
3273 errbnd = addbnd *
max(
max( sumrpos, sumrneg ),
3274 $
max( sumipos, sumineg ) )
3275
3276 RETURN
3277
3278
3279