3777
3778
3779
3780
3781
3782
3783
3784 DOUBLE PRECISION ERRBND, PREC
3785 COMPLEX*16 PSCLR, X, Y
3786
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 DOUBLE PRECISION ONE, TWO, ZERO
3821 parameter( one = 1.0d+0, two = 2.0d+0,
3822 $ zero = 0.0d+0 )
3823
3824
3825 DOUBLE PRECISION ADDBND, FACT, SUMINEG, SUMIPOS, SUMRNEG,
3826 $ SUMRPOS
3827 COMPLEX*16 TMP
3828
3829
3830 INTRINSIC dble, dimag,
max
3831
3832
3833
3834 sumipos = zero
3835 sumineg = zero
3836 sumrpos = zero
3837 sumrneg = zero
3838 fact = one + two * prec
3839 addbnd = two * two * two * prec
3840
3841 tmp = psclr * x
3842 IF( dble( tmp ).GE.zero ) THEN
3843 sumrpos = sumrpos + dble( tmp ) * fact
3844 ELSE
3845 sumrneg = sumrneg - dble( tmp ) * fact
3846 END IF
3847 IF( dimag( tmp ).GE.zero ) THEN
3848 sumipos = sumipos + dimag( tmp ) * fact
3849 ELSE
3850 sumineg = sumineg - dimag( tmp ) * fact
3851 END IF
3852
3853 tmp = y
3854 IF( dble( tmp ).GE.zero ) THEN
3855 sumrpos = sumrpos + dble( tmp )
3856 ELSE
3857 sumrneg = sumrneg - dble( tmp )
3858 END IF
3859 IF( dimag( tmp ).GE.zero ) THEN
3860 sumipos = sumipos + dimag( tmp )
3861 ELSE
3862 sumineg = sumineg - dimag( tmp )
3863 END IF
3864
3865 y = y + ( psclr * x )
3866
3867 errbnd = addbnd *
max(
max( sumrpos, sumrneg ),
3868 $
max( sumipos, sumineg ) )
3869
3870 RETURN
3871
3872
3873