 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 PROGRAM PETIT_TEST 00002 COMMON/COMBLA/NPRINT,ICASE,N,INCX,INCY,MODE,PASS 00003 LOGICAL PASS 00004 DOUBLE PRECISION DAB(4,9),DTEMP(9),DTRUE(9,9) 00005 C INPUT FOR MODIFIED GIVENS 00006 DATA DAB/ .1D0,.3D0,1.2D0,.2D0, 00007 A .7D0, .2D0, .6D0, 4.2D0, 00008 B 0.D0,0.D0,0.D0,0.D0, 00009 C 4.D0, -1.D0, 2.D0, 4.D0, 00010 D 6.D-10, 2.D-2, 1.D5, 10.D0, 00011 E 4.D10, 2.D-2, 1.D-5, 10.D0, 00012 F 2.D-10, 4.D-2, 1.D5, 10.D0, 00013 G 2.D10, 4.D-2, 1.D-5, 10.D0, 00014 H 4.D0, -2.D0, 8.D0, 4.D0 / 00015 C TRUE RESULTS FOR MODIFIED GIVENS 00016 DATA DTRUE/0.D0,0.D0, 1.3D0, .2D0, 0.D0,0.D0,0.D0, .5D0, 0.D0, 00017 A 0.D0,0.D0, 4.5D0, 4.2D0, 1.D0, .5D0, 0.D0,0.D0,0.D0, 00018 B 0.D0,0.D0,0.D0,0.D0, -2.D0, 0.D0,0.D0,0.D0,0.D0, 00019 C 0.D0,0.D0,0.D0, 4.D0, -1.D0, 0.D0,0.D0,0.D0,0.D0, 00020 D 0.D0, 15.D-3, 0.D0, 10.D0, -1.D0, 0.D0, -1.D-4, 00021 E 0.D0, 1.D0, 00022 F 0.D0,0.D0, 6144.D-5, 10.D0, -1.D0, 4096.D0, -1.D6, 00023 G 0.D0, 1.D0, 00024 H 0.D0,0.D0,15.D0,10.D0,-1.D0, 5.D-5, 0.D0,1.D0,0.D0, 00025 I 0.D0,0.D0, 15.D0, 10.D0, -1. D0, 5.D5, -4096.D0, 00026 J 1.D0, 4096.D-6, 00027 K 0.D0,0.D0, 7.D0, 4.D0, 0.D0,0.D0, -.5D0, -.25D0, 0.D0/ 00028 C 4096 = 2 ** 12 00029 DATA D12 /4096.D0/ 00030 DTRUE(1,1) = 12.D0 / 130.D0 00031 DTRUE(2,1) = 36.D0 / 130.D0 00032 DTRUE(7,1) = -1.D0 / 6.D0 00033 DTRUE(1,2) = 14.D0 / 75.D0 00034 DTRUE(2,2) = 49.D0 / 75.D0 00035 DTRUE(9,2) = 1.D0 / 7.D0 00036 DTRUE(1,5) = 45.D-11 * (D12 * D12) 00037 DTRUE(3,5) = 4.D5 / (3.D0 * D12) 00038 DTRUE(6,5) = 1.D0 / D12 00039 DTRUE(8,5) = 1.D4 / (3.D0 * D12) 00040 DTRUE(1,6) = 4.D10 / (1.5D0 * D12 * D12) 00041 DTRUE(2,6) = 2.D-2 / 1.5D0 00042 DTRUE(8,6) = 5.D-7 * D12 00043 DTRUE(1,7) = 4.D0 / 150.D0 00044 DTRUE(2,7) = (2.D-10 / 1.5D0) * (D12 * D12) 00045 DTRUE(7,7) = -DTRUE(6,5) 00046 DTRUE(9,7) = 1.D4 / D12 00047 DTRUE(1,8) = DTRUE(1,7) 00048 DTRUE(2,8) = 2.D10 / (1.5D0 * D12 * D12) 00049 DTRUE(1,9) = 32.D0 / 7.D0 00050 DTRUE(2,9) = -16.D0 / 7.D0 00051 PASS=.TRUE. 00052 00053 DO K=1,9 00054 DO I=1,4 00055 DTEMP(I)= DAB(I,K) 00056 DTEMP(I+4) = 0.0 00057 END DO 00058 DTEMP(9) = 0.0 00059 CALL DROTMG(DTEMP(1),DTEMP(2),DTEMP(3),DTEMP(4),DTEMP(5)) 00060 DO I=1,9 00061 IF (ABS(DTEMP(I)-DTRUE(I,K)) .GT. 0.0001 ) THEN 00062 WRITE(*,*) "DTEMP-DTRUE=",I,DTEMP(I)-DTRUE(I,K) 00063 END IF 00064 END DO 00065 CALL DTEST(9,DTEMP,DTRUE(1,K),DTRUE(1,K)) 00066 END DO 00067 IF(PASS) WRITE(NPRINT,1001) 00068 1001 FORMAT(1H+,39X,4HPASS) 00069 END 00070 00071 SUBROUTINE DTEST(LEN,DCOMP,DTRUE,DSIZE) 00072 C1 ********************************* DTEST ************************** 00073 C 00074 C THIS SUBR COMPARES ARRAYS DCOMP() AND DTRUE() OF LENGTH LEN TO 00075 C SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY DFAC, ARE 00076 C NEGLIGIBLE. 00077 C 00078 C C. L. LAWSON, JPL, 1974 DEC 10 00079 C2 00080 COMMON/COMBLA/NPRINT,ICASE,N,INCX,INCY,MODE,PASS 00081 LOGICAL PASS 00082 DOUBLE PRECISION DCOMP(LEN),DTRUE(LEN),DSIZE(LEN),DFAC,DDIFF,DD 00083 DFAC=0.625D-1 00084 C 00085 DO 10 I=1,LEN 00086 DD = DCOMP(I)-DTRUE(I) 00087 IF((DABS(DSIZE(I))+DABS(DFAC*DD)-DABS(DSIZE(I))) .EQ. 0.D0) THEN 00088 GO TO 10 00089 END IF 00090 C 00091 C HERE DCOMP(I) IS NOT CLOSE TO DTRUE(I). 00092 C 00093 IF(.NOT. PASS) GO TO 5 00094 C PRINT FAIL MESSAGE AND HEADER. 00095 PASS = .FALSE. 00096 WRITE(NPRINT,1000) 00097 WRITE(NPRINT,1001) 00098 5 WRITE(NPRINT,1002) ICASE,N,INCX,INCY,MODE,I, 00099 * DCOMP(I),DTRUE(I),DD,DSIZE(I) 00100 10 CONTINUE 00101 00102 RETURN 00103 1000 FORMAT(1H+,39X,4HFAIL) 00104 1001 FORMAT(26H0CASE N INCX INCY MODE I, 00105 1 29X,7HCOMP(I),29X,7HTRUE(I),2X,10HDIFFERENCE, 00106 2 5X,7HSIZE(I)/1X) 00107 1002 FORMAT(1X,I4,I3,3I5,I3,2D36.18,2D12.4) 00108 END
1.7.3 
