* * $Id: c344q.F,v 1.1.1.1 1996/04/01 15:01:19 mclareni Exp $ * * $Log: c344q.F,v $ * Revision 1.1.1.1 1996/04/01 15:01:19 mclareni * Mathlib gen * * #include "gen/pilot.h" #if defined(CERNLIB_IBMVM) SUBROUTINE C344Q C Test for C344 (CBSJA, WBSJA,) WQBSJA ON IBMVM and systems C which support Complex*32 #include "gen/imp128.inc" COMPLEX RI #include "gen/defc64.inc" + DI #include "gen/defc128.inc" + QI,ZI,Z,BJ,TBJ LOGICAL LTEST1 DIMENSION TBJ(36),BJ(0:101) COMMON /C344LT1/LTEST1 #include "iorc.inc" DATA TBJ( 1) / ( 1.17985 66304 03078 01780 46794 59588 163Q 0, 1 -0.27372 67855 91011 18964 48065 68496 921Q 0)/ DATA TBJ( 2) / ( 0.33926 01907 19886 24479 35808 69499 395Q 0, 1 0.51241 37767 28090 57078 57667 74624 361Q 0)/ DATA TBJ( 3) / ( 0.33074 03512 61626 84670 55722 89412 872Q-3, 1 -0.33308 02032 66721 18213 28183 14447 211Q-3)/ DATA TBJ( 4) / ( 0.88401 30734 14786 85386 41721 22706 474Q 0, 1 0.36852 42166 04181 21348 15572 06360 092Q 0)/ DATA TBJ( 5) / ( 0.26995 60489 06068 53666 89280 76134 773Q-2, 1 0.33907 73825 39429 12118 04462 74060 416Q 0)/ DATA TBJ( 6) / ( 0.14202 06090 81604 57666 06535 69381 053Q-3, 1 -0.33580 13618 18163 97607 08014 16981 086Q-4)/ DATA TBJ( 7) / ( 0.43931 51319 83363 40153 02631 94465 136Q 0, 1 0.51992 02616 49293 16785 92188 98838 566Q 0)/ DATA TBJ( 8) / (-0.83786 30365 01135 58763 65404 88771 942Q-1, 1 0.17434 36468 61320 97689 79869 52964 775Q 0)/ DATA TBJ( 9) / ( 0.54371 90050 04851 56261 63796 54528 383Q-4, 1 0.11753 02513 31863 94332 76918 62879 626Q-4)/ DATA TBJ(10) / (-0.38170 32673 39424 54276 23316 30974 157Q 0, 1 -0.46421 91069 09706 84520 05743 10193 181Q-1)/ DATA TBJ(11) / ( 0.52205 24416 52373 86516 72860 07248 290Q-1, 1 -0.29346 76318 08170 03778 36714 64465 674Q 0)/ DATA TBJ(12) / (-0.33276 41407 70354 40801 05546 70446 264Q 0, 1 -0.11466 07331 95216 13885 78979 85383 207Q 0)/ DATA TBJ(13) / (-0.22338 33555 70224 71912 93662 05588 564Q 0, 1 -0.23734 94808 33689 43017 29143 33179 325Q 0)/ DATA TBJ(14) / ( 0.29298 48795 57162 62473 57005 19909 919Q 0, 1 -0.19823 30922 78524 50591 88946 19526 558Q 0)/ DATA TBJ(15) / (-0.20147 45398 40364 92508 28068 09666 283Q 0, 1 -0.21144 21422 44644 75676 27836 72718 430Q 0)/ DATA TBJ(16) / (-0.48960 62952 12114 60862 12664 25076 681Q-2, 1 -0.29514 59584 18304 65886 74307 15839 425Q 0)/ DATA TBJ(17) / ( 0.38202 04610 81631 76842 90697 43260 515Q 0, 1 -0.52596 85202 14131 68732 73827 89775 616Q-1)/ DATA TBJ(18) / (-0.65522 16673 03546 09385 85623 20376 021Q-1, 1 -0.24671 16320 17088 28223 56185 95350 511Q 0)/ DATA TBJ(19) / ( 0.25032 11703 17130 79307 14892 97629 883Q 4, 1 -0.12851 88919 49093 85293 37044 44171 662Q 4)/ DATA TBJ(20) / ( 0.12259 19306 52295 75536 56209 70479 971Q 4, 1 0.23714 92582 46704 84107 98925 62458 977Q 4)/ DATA TBJ(21) / ( 0.39986 77983 96927 40802 61667 88602 061Q 3, 1 0.66870 65110 74518 97852 19553 51862 602Q 3)/ DATA TBJ(22) / ( 0.26443 58614 14535 79018 85120 76163 814Q 4, 1 0.84816 11959 28194 06351 93948 80167 942Q 3)/ DATA TBJ(23) / (-0.75036 77778 99233 95551 97672 50133 438Q 3, 1 0.23848 12427 13301 89308 88613 73393 539Q 4)/ DATA TBJ(24) / (-0.13898 68630 88923 95512 02590 85052 020Q 3, 1 0.58308 13008 93289 46975 69076 24790 536Q 3)/ DATA TBJ(25) / ( 0.15965 42990 36374 85566 23283 01616 929Q 4, 1 0.21729 51256 13406 41861 34548 38956 146Q 4)/ DATA TBJ(26) / (-0.18656 13704 64616 90665 90544 33883 776Q 4, 1 0.13929 90120 76962 36011 54033 82873 118Q 4)/ DATA TBJ(27) / (-0.35981 34713 72210 88987 18308 51040 394Q 3, 1 0.31498 30276 17234 18622 81207 65263 609Q 3)/ DATA TBJ(28) / (-0.23149 75314 44521 30119 56031 83751 232Q 4, 1 0.41156 28570 25380 52302 04516 78960 149Q 3)/ DATA TBJ(29) / (-0.46068 09135 38352 86288 99034 58135 225Q 3, 1 -0.22466 26790 70405 87882 31889 61283 744Q 4)/ DATA TBJ(30) / (-0.92039 40387 97411 49468 28994 28237 629Q 3, 1 -0.84634 51974 60902 69298 82464 55209 906Q 3)/ DATA TBJ(31) / (-0.19247 35521 84853 44588 33241 55950 936Q 4, 1 -0.13249 22612 82940 12246 61659 74595 274Q 4)/ DATA TBJ(32) / ( 0.11624 39715 56797 00173 25344 54705 875Q 4, 1 -0.18947 44874 64917 63229 20626 75866 016Q 4)/ DATA TBJ(33) / (-0.19227 78243 81317 42543 80806 51209 982Q 3, 1 -0.10757 42218 10489 94443 50937 27259 647Q 4)/ DATA TBJ(34) / (-0.79950 19891 46231 03508 60497 08802 295Q 3, 1 -0.21611 22238 29237 10956 11446 47452 777Q 4)/ DATA TBJ(35) / ( 0.19548 79344 68663 86835 14093 88756 840Q 4, 1 -0.89157 66532 99052 59726 95998 26195 815Q 3)/ DATA TBJ(36) / ( 0.31919 91610 01702 47591 24438 80788 995Q 3, 1 -0.91765 71746 72151 66793 40504 69222 067Q 3)/ PARAMETER (R0 = 0, R1 = 1, HF = R1/2) PARAMETER (RI = (0.,1.)) PARAMETER (DI = (0D0,1D0)) PARAMETER (QI = (0Q0,1Q0)) PARAMETER ( TSTERR= 1Q-30 ) ERRMAX= 0 LTEST1=.TRUE. WRITE(LOUT,'(/5X,''A'',4X,''N'',7X,''Z'',46X,''BJ(N)'', +40X,''ERR'')') ZI=QI IC=0 DO 1 IZ = 1,4 IF(IZ .EQ. 1) Z=HF+ZI IF(IZ .EQ. 2) Z=10+ZI IF(IZ .EQ. 3) Z=HF+10*ZI IF(IZ .EQ. 4) Z=10+10*ZI DO 2 IA = 1,3 IF(IA .EQ. 1) A=0 IF(IA .EQ. 2) A=HF IF(IA .EQ. 3) A=9*R1/10 DO 3 IN = 1,3 IF(IN .EQ. 1) N=0 IF(IN .EQ. 2) N=1 IF(IN .EQ. 3) N=5 IC=IC+1 ND=31 CALL WQBSJA(Z,A,N,ND,BJ) ERR=ABS((TBJ(IC)-BJ(N))/TBJ(IC)) #if defined(CERNLIB_IBMVM) WRITE(LOUT,'(1X,F6.1,I4,2F6.1,1P,2Q42.32,Q10.1/)') #endif #if !defined(CERNLIB_IBMVM) WRITE(LOUT,'(1X,F6.1,I4,2F6.1,1P,2D42.32,D10.1/)') #endif + A,N,Z,BJ(N),ERR ERRMAX= MAX( ERRMAX,ERR ) LTEST1=LTEST1 .AND. ERRMAX .LE. TSTERR 3 CONTINUE 2 CONTINUE 1 CONTINUE WRITE(LOUT,'(/'' Largest Relative Error was'',1P,E10.1)')ERRMAX WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)') CALL WQBSJA(-R1+R0*ZI,R0,1,ND,BJ) CALL WQBSJA(ZI,2*R1,1,ND,BJ) CALL WQBSJA(ZI,HF,101,ND,BJ) RETURN END #endif #if !defined(CERNLIB_DOUBLE) C Test for C344 WBSJA ON CRAY AND ALIKE SUBROUTINE C344Q #include "gen/imp128.inc" DIMENSION T(2,36),Z(2),BJ(2,0:101),D1(2),D2(2),D(2) LOGICAL LTEST2 COMMON /C344LT2/LTEST2 #include "iorc.inc" DATA T(1, 1) / 1.17985 66304 03078 01780 46794 59588D 0/ DATA T(2, 1) / -0.27372 67855 91011 18964 48065 68497D 0/ DATA T(1, 2) / 0.33926 01907 19886 24479 35808 69499D 0/ DATA T(2, 2) / 0.51241 37767 28090 57078 57667 74624D 0/ DATA T(1, 3) / 0.33074 03512 61626 84670 55722 89413D-3/ DATA T(2, 3) / -0.33308 02032 66721 18213 28183 14447D-3/ DATA T(1, 4) / 0.88401 30734 14786 85386 41721 22706D 0/ DATA T(2, 4) / 0.36852 42166 04181 21348 15572 06360D 0/ DATA T(1, 5) / 0.26995 60489 06068 53666 89280 76135D-2/ DATA T(2, 5) / 0.33907 73825 39429 12118 04462 74060D 0/ DATA T(1, 6) / 0.14202 06090 81604 57666 06535 69381D-3/ DATA T(2, 6) / -0.33580 13618 18163 97607 08014 16981D-4/ DATA T(1, 7) / 0.43931 51319 83363 40153 02631 94465D 0/ DATA T(2, 7) / 0.51992 02616 49293 16785 92188 98839D 0/ DATA T(1, 8) / -0.83786 30365 01135 58763 65404 88772D-1/ DATA T(2, 8) / 0.17434 36468 61320 97689 79869 52965D 0/ DATA T(1, 9) / 0.54371 90050 04851 56261 63796 54528D-4/ DATA T(2, 9) / 0.11753 02513 31863 94332 76918 62880D-4/ DATA T(1,10) / -0.38170 32673 39424 54276 23316 30974D 0/ DATA T(2,10) / -0.46421 91069 09706 84520 05743 10193D-1/ DATA T(1,11) / 0.52205 24416 52373 86516 72860 07248D-1/ DATA T(2,11) / -0.29346 76318 08170 03778 36714 64466D 0/ DATA T(1,12) / -0.33276 41407 70354 40801 05546 70446D 0/ DATA T(2,12) / -0.11466 07331 95216 13885 78979 85383D 0/ DATA T(1,13) / -0.22338 33555 70224 71912 93662 05589D 0/ DATA T(2,13) / -0.23734 94808 33689 43017 29143 33179D 0/ DATA T(1,14) / 0.29298 48795 57162 62473 57005 19910D 0/ DATA T(2,14) / -0.19823 30922 78524 50591 88946 19527D 0/ DATA T(1,15) / -0.20147 45398 40364 92508 28068 09666D 0/ DATA T(2,15) / -0.21144 21422 44644 75676 27836 72718D 0/ DATA T(1,16) / -0.48960 62952 12114 60862 12664 25077D-2/ DATA T(2,16) / -0.29514 59584 18304 65886 74307 15839D 0/ DATA T(1,17) / 0.38202 04610 81631 76842 90697 43261D 0/ DATA T(2,17) / -0.52596 85202 14131 68732 73827 89776D-1/ DATA T(1,18) / -0.65522 16673 03546 09385 85623 20376D-1/ DATA T(2,18) / -0.24671 16320 17088 28223 56185 95351D 0/ DATA T(1,19) / 0.25032 11703 17130 79307 14892 97630D 4/ DATA T(2,19) / -0.12851 88919 49093 85293 37044 44172D 4/ DATA T(1,20) / 0.12259 19306 52295 75536 56209 70480D 4/ DATA T(2,20) / 0.23714 92582 46704 84107 98925 62459D 4/ DATA T(1,21) / 0.39986 77983 96927 40802 61667 88602D 3/ DATA T(2,21) / 0.66870 65110 74518 97852 19553 51863D 3/ DATA T(1,22) / 0.26443 58614 14535 79018 85120 76164D 4/ DATA T(2,22) / 0.84816 11959 28194 06351 93948 80168D 3/ DATA T(1,23) / -0.75036 77778 99233 95551 97672 50133D 3/ DATA T(2,23) / 0.23848 12427 13301 89308 88613 73394D 4/ DATA T(1,24) / -0.13898 68630 88923 95512 02590 85052D 3/ DATA T(2,24) / 0.58308 13008 93289 46975 69076 24791D 3/ DATA T(1,25) / 0.15965 42990 36374 85566 23283 01617D 4/ DATA T(2,25) / 0.21729 51256 13406 41861 34548 38956D 4/ DATA T(1,26) / -0.18656 13704 64616 90665 90544 33884D 4/ DATA T(2,26) / 0.13929 90120 76962 36011 54033 82873D 4/ DATA T(1,27) / -0.35981 34713 72210 88987 18308 51040D 3/ DATA T(2,27) / 0.31498 30276 17234 18622 81207 65264D 3/ DATA T(1,28) / -0.23149 75314 44521 30119 56031 83751D 4/ DATA T(2,28) / 0.41156 28570 25380 52302 04516 78960D 3/ DATA T(1,29) / -0.46068 09135 38352 86288 99034 58135D 3/ DATA T(2,29) / -0.22466 26790 70405 87882 31889 61284D 4/ DATA T(1,30) / -0.92039 40387 97411 49468 28994 28238D 3/ DATA T(2,30) / -0.84634 51974 60902 69298 82464 55210D 3/ DATA T(1,31) / -0.19247 35521 84853 44588 33241 55951D 4/ DATA T(2,31) / -0.13249 22612 82940 12246 61659 74595D 4/ DATA T(1,32) / 0.11624 39715 56797 00173 25344 54706D 4/ DATA T(2,32) / -0.18947 44874 64917 63229 20626 75866D 4/ DATA T(1,33) / -0.19227 78243 81317 42543 80806 51210D 3/ DATA T(2,33) / -0.10757 42218 10489 94443 50937 27260D 4/ DATA T(1,34) / -0.79950 19891 46231 03508 60497 08802D 3/ DATA T(2,34) / -0.21611 22238 29237 10956 11446 47453D 4/ DATA T(1,35) / 0.19548 79344 68663 86835 14093 88757D 4/ DATA T(2,35) / -0.89157 66532 99052 59726 95998 26196D 3/ DATA T(1,36) / 0.31919 91610 01702 47591 24438 80789D 3/ DATA T(2,36) / -0.91765 71746 72151 66793 40504 69222D 3/ PARAMETER (R0 = 0, R1 = 1, HF = R1/2) PARAMETER ( TSTERR= 5D-28 ) LTEST2=.TRUE. ERRMAX= 0 IC=0 DO 1 IZ = 1,4 IF(IZ .EQ. 1) THEN Z(1)=HF Z(2)=1 ELSEIF(IZ .EQ. 2) THEN Z(1)=10 Z(2)=1 ELSEIF(IZ .EQ. 3) THEN Z(1)=HF Z(2)=10 ELSEIF(IZ .EQ. 4) THEN Z(1)=10 Z(2)=10 ENDIF DO 2 IA = 1,3 IF(IA .EQ. 1) A=0 IF(IA .EQ. 2) A=HF IF(IA .EQ. 3) A=9*R1/10 DO 3 IN = 1,3 IF(IN .EQ. 1) N=0 IF(IN .EQ. 2) N=1 IF(IN .EQ. 3) N=5 IC=IC+1 ND=27 CALL WBSJA(Z,A,N,ND,BJ) D1(1)=T(1,IC)-BJ(1,N) D1(2)=T(2,IC)-BJ(2,N) D2(1)=T(1,IC) D2(2)=T(2,IC) R=D2(1)**2+D2(2)**2 D(1)=(D1(1)*D2(1)+D1(2)*D2(2))/R D(2)=(D2(1)*D1(2)-D1(1)*D2(2))/R ERR=SQRT(D(1)**2+D(2)**2) ERRMAX= MAX( ERRMAX,ERR ) LTEST2=LTEST2 .AND. ERRMAX .LE. TSTERR WRITE(LOUT,'(1X,F6.1,I4,2F6.1,1P,2E42.32,E10.1/)') 1 A,N,Z(1),Z(2),BJ(1,N),BJ(2,N),ERR 3 CONTINUE 2 CONTINUE 1 CONTINUE WRITE(LOUT,'(/'' Largest Relative Error was'',1P,E10.1)')ERRMAX WRITE(LOUT,'(/''TESTING ERROR MESSAGES:''/)') Z(1)=-1 Z(2)=0 CALL WBSJA(Z,R0,1,ND,BJ) Z(1)=0 Z(2)=1 CALL WBSJA(Z,2*R1,1,ND,BJ) CALL WBSJA(Z,HF,101,ND,BJ) END #endif