3778
3779
3780
3781
3782
3783
3784
3785 REAL ERRBND, PREC
3786 COMPLEX PSCLR, X, Y
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821 REAL ONE, TWO, ZERO
3822 parameter( one = 1.0e+0, two = 2.0e+0,
3823 $ zero = 0.0e+0 )
3824
3825
3826 REAL ADDBND, FACT, SUMINEG, SUMIPOS, SUMRNEG,
3827 $ SUMRPOS
3828 COMPLEX TMP
3829
3830
3831 INTRINSIC aimag,
max, real
3832
3833
3834
3835 sumipos = zero
3836 sumineg = zero
3837 sumrpos = zero
3838 sumrneg = zero
3839 fact = one + two * prec
3840 addbnd = two * two * two * prec
3841
3842 tmp = psclr * x
3843 IF( real( tmp ).GE.zero ) THEN
3844 sumrpos = sumrpos + real( tmp ) * fact
3845 ELSE
3846 sumrneg = sumrneg - real( tmp ) * fact
3847 END IF
3848 IF( aimag( tmp ).GE.zero ) THEN
3849 sumipos = sumipos + aimag( tmp ) * fact
3850 ELSE
3851 sumineg = sumineg - aimag( tmp ) * fact
3852 END IF
3853
3854 tmp = y
3855 IF( real( tmp ).GE.zero ) THEN
3856 sumrpos = sumrpos + real( tmp )
3857 ELSE
3858 sumrneg = sumrneg - real( tmp )
3859 END IF
3860 IF( aimag( tmp ).GE.zero ) THEN
3861 sumipos = sumipos + aimag( tmp )
3862 ELSE
3863 sumineg = sumineg - aimag( tmp )
3864 END IF
3865
3866 y = y + ( psclr * x )
3867
3868 errbnd = addbnd *
max(
max( sumrpos, sumrneg ),
3869 $
max( sumipos, sumineg ) )
3870
3871 RETURN
3872
3873
3874