00001 SUBROUTINE DERRRQ( PATH, NUNIT )
00002
00003
00004
00005
00006
00007
00008 CHARACTER*3 PATH
00009 INTEGER NUNIT
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030 INTEGER NMAX
00031 PARAMETER ( NMAX = 2 )
00032
00033
00034 INTEGER I, INFO, J
00035
00036
00037 DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
00038 $ W( NMAX ), X( NMAX )
00039
00040
00041 EXTERNAL ALAESM, CHKXER, DGERQ2, DGERQF, DGERQS, DORGR2,
00042 $ DORGRQ, DORMR2, DORMRQ
00043
00044
00045 LOGICAL LERR, OK
00046 CHARACTER*32 SRNAMT
00047 INTEGER INFOT, NOUT
00048
00049
00050 COMMON / INFOC / INFOT, NOUT, OK, LERR
00051 COMMON / SRNAMC / SRNAMT
00052
00053
00054 INTRINSIC DBLE
00055
00056
00057
00058 NOUT = NUNIT
00059 WRITE( NOUT, FMT = * )
00060
00061
00062
00063 DO 20 J = 1, NMAX
00064 DO 10 I = 1, NMAX
00065 A( I, J ) = 1.D0 / DBLE( I+J )
00066 AF( I, J ) = 1.D0 / DBLE( I+J )
00067 10 CONTINUE
00068 B( J ) = 0.D0
00069 W( J ) = 0.D0
00070 X( J ) = 0.D0
00071 20 CONTINUE
00072 OK = .TRUE.
00073
00074
00075
00076
00077
00078 SRNAMT = 'DGERQF'
00079 INFOT = 1
00080 CALL DGERQF( -1, 0, A, 1, B, W, 1, INFO )
00081 CALL CHKXER( 'DGERQF', INFOT, NOUT, LERR, OK )
00082 INFOT = 2
00083 CALL DGERQF( 0, -1, A, 1, B, W, 1, INFO )
00084 CALL CHKXER( 'DGERQF', INFOT, NOUT, LERR, OK )
00085 INFOT = 4
00086 CALL DGERQF( 2, 1, A, 1, B, W, 2, INFO )
00087 CALL CHKXER( 'DGERQF', INFOT, NOUT, LERR, OK )
00088 INFOT = 7
00089 CALL DGERQF( 2, 1, A, 2, B, W, 1, INFO )
00090 CALL CHKXER( 'DGERQF', INFOT, NOUT, LERR, OK )
00091
00092
00093
00094 SRNAMT = 'DGERQ2'
00095 INFOT = 1
00096 CALL DGERQ2( -1, 0, A, 1, B, W, INFO )
00097 CALL CHKXER( 'DGERQ2', INFOT, NOUT, LERR, OK )
00098 INFOT = 2
00099 CALL DGERQ2( 0, -1, A, 1, B, W, INFO )
00100 CALL CHKXER( 'DGERQ2', INFOT, NOUT, LERR, OK )
00101 INFOT = 4
00102 CALL DGERQ2( 2, 1, A, 1, B, W, INFO )
00103 CALL CHKXER( 'DGERQ2', INFOT, NOUT, LERR, OK )
00104
00105
00106
00107 SRNAMT = 'DGERQS'
00108 INFOT = 1
00109 CALL DGERQS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO )
00110 CALL CHKXER( 'DGERQS', INFOT, NOUT, LERR, OK )
00111 INFOT = 2
00112 CALL DGERQS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO )
00113 CALL CHKXER( 'DGERQS', INFOT, NOUT, LERR, OK )
00114 INFOT = 2
00115 CALL DGERQS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO )
00116 CALL CHKXER( 'DGERQS', INFOT, NOUT, LERR, OK )
00117 INFOT = 3
00118 CALL DGERQS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO )
00119 CALL CHKXER( 'DGERQS', INFOT, NOUT, LERR, OK )
00120 INFOT = 5
00121 CALL DGERQS( 2, 2, 0, A, 1, X, B, 2, W, 1, INFO )
00122 CALL CHKXER( 'DGERQS', INFOT, NOUT, LERR, OK )
00123 INFOT = 8
00124 CALL DGERQS( 2, 2, 0, A, 2, X, B, 1, W, 1, INFO )
00125 CALL CHKXER( 'DGERQS', INFOT, NOUT, LERR, OK )
00126 INFOT = 10
00127 CALL DGERQS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO )
00128 CALL CHKXER( 'DGERQS', INFOT, NOUT, LERR, OK )
00129
00130
00131
00132 SRNAMT = 'DORGRQ'
00133 INFOT = 1
00134 CALL DORGRQ( -1, 0, 0, A, 1, X, W, 1, INFO )
00135 CALL CHKXER( 'DORGRQ', INFOT, NOUT, LERR, OK )
00136 INFOT = 2
00137 CALL DORGRQ( 0, -1, 0, A, 1, X, W, 1, INFO )
00138 CALL CHKXER( 'DORGRQ', INFOT, NOUT, LERR, OK )
00139 INFOT = 2
00140 CALL DORGRQ( 2, 1, 0, A, 2, X, W, 2, INFO )
00141 CALL CHKXER( 'DORGRQ', INFOT, NOUT, LERR, OK )
00142 INFOT = 3
00143 CALL DORGRQ( 0, 0, -1, A, 1, X, W, 1, INFO )
00144 CALL CHKXER( 'DORGRQ', INFOT, NOUT, LERR, OK )
00145 INFOT = 3
00146 CALL DORGRQ( 1, 2, 2, A, 1, X, W, 1, INFO )
00147 CALL CHKXER( 'DORGRQ', INFOT, NOUT, LERR, OK )
00148 INFOT = 5
00149 CALL DORGRQ( 2, 2, 0, A, 1, X, W, 2, INFO )
00150 CALL CHKXER( 'DORGRQ', INFOT, NOUT, LERR, OK )
00151 INFOT = 8
00152 CALL DORGRQ( 2, 2, 0, A, 2, X, W, 1, INFO )
00153 CALL CHKXER( 'DORGRQ', INFOT, NOUT, LERR, OK )
00154
00155
00156
00157 SRNAMT = 'DORGR2'
00158 INFOT = 1
00159 CALL DORGR2( -1, 0, 0, A, 1, X, W, INFO )
00160 CALL CHKXER( 'DORGR2', INFOT, NOUT, LERR, OK )
00161 INFOT = 2
00162 CALL DORGR2( 0, -1, 0, A, 1, X, W, INFO )
00163 CALL CHKXER( 'DORGR2', INFOT, NOUT, LERR, OK )
00164 INFOT = 2
00165 CALL DORGR2( 2, 1, 0, A, 2, X, W, INFO )
00166 CALL CHKXER( 'DORGR2', INFOT, NOUT, LERR, OK )
00167 INFOT = 3
00168 CALL DORGR2( 0, 0, -1, A, 1, X, W, INFO )
00169 CALL CHKXER( 'DORGR2', INFOT, NOUT, LERR, OK )
00170 INFOT = 3
00171 CALL DORGR2( 1, 2, 2, A, 2, X, W, INFO )
00172 CALL CHKXER( 'DORGR2', INFOT, NOUT, LERR, OK )
00173 INFOT = 5
00174 CALL DORGR2( 2, 2, 0, A, 1, X, W, INFO )
00175 CALL CHKXER( 'DORGR2', INFOT, NOUT, LERR, OK )
00176
00177
00178
00179 SRNAMT = 'DORMRQ'
00180 INFOT = 1
00181 CALL DORMRQ( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
00182 CALL CHKXER( 'DORMRQ', INFOT, NOUT, LERR, OK )
00183 INFOT = 2
00184 CALL DORMRQ( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
00185 CALL CHKXER( 'DORMRQ', INFOT, NOUT, LERR, OK )
00186 INFOT = 3
00187 CALL DORMRQ( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
00188 CALL CHKXER( 'DORMRQ', INFOT, NOUT, LERR, OK )
00189 INFOT = 4
00190 CALL DORMRQ( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, 1, INFO )
00191 CALL CHKXER( 'DORMRQ', INFOT, NOUT, LERR, OK )
00192 INFOT = 5
00193 CALL DORMRQ( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, 1, INFO )
00194 CALL CHKXER( 'DORMRQ', INFOT, NOUT, LERR, OK )
00195 INFOT = 5
00196 CALL DORMRQ( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, 1, INFO )
00197 CALL CHKXER( 'DORMRQ', INFOT, NOUT, LERR, OK )
00198 INFOT = 5
00199 CALL DORMRQ( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, 1, INFO )
00200 CALL CHKXER( 'DORMRQ', INFOT, NOUT, LERR, OK )
00201 INFOT = 7
00202 CALL DORMRQ( 'L', 'N', 2, 1, 2, A, 1, X, AF, 2, W, 1, INFO )
00203 CALL CHKXER( 'DORMRQ', INFOT, NOUT, LERR, OK )
00204 INFOT = 7
00205 CALL DORMRQ( 'R', 'N', 1, 2, 2, A, 1, X, AF, 1, W, 1, INFO )
00206 CALL CHKXER( 'DORMRQ', INFOT, NOUT, LERR, OK )
00207 INFOT = 10
00208 CALL DORMRQ( 'L', 'N', 2, 1, 0, A, 1, X, AF, 1, W, 1, INFO )
00209 CALL CHKXER( 'DORMRQ', INFOT, NOUT, LERR, OK )
00210 INFOT = 12
00211 CALL DORMRQ( 'L', 'N', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO )
00212 CALL CHKXER( 'DORMRQ', INFOT, NOUT, LERR, OK )
00213 INFOT = 12
00214 CALL DORMRQ( 'R', 'N', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO )
00215 CALL CHKXER( 'DORMRQ', INFOT, NOUT, LERR, OK )
00216
00217
00218
00219 SRNAMT = 'DORMR2'
00220 INFOT = 1
00221 CALL DORMR2( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, INFO )
00222 CALL CHKXER( 'DORMR2', INFOT, NOUT, LERR, OK )
00223 INFOT = 2
00224 CALL DORMR2( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, INFO )
00225 CALL CHKXER( 'DORMR2', INFOT, NOUT, LERR, OK )
00226 INFOT = 3
00227 CALL DORMR2( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, INFO )
00228 CALL CHKXER( 'DORMR2', INFOT, NOUT, LERR, OK )
00229 INFOT = 4
00230 CALL DORMR2( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, INFO )
00231 CALL CHKXER( 'DORMR2', INFOT, NOUT, LERR, OK )
00232 INFOT = 5
00233 CALL DORMR2( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, INFO )
00234 CALL CHKXER( 'DORMR2', INFOT, NOUT, LERR, OK )
00235 INFOT = 5
00236 CALL DORMR2( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, INFO )
00237 CALL CHKXER( 'DORMR2', INFOT, NOUT, LERR, OK )
00238 INFOT = 5
00239 CALL DORMR2( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, INFO )
00240 CALL CHKXER( 'DORMR2', INFOT, NOUT, LERR, OK )
00241 INFOT = 7
00242 CALL DORMR2( 'L', 'N', 2, 1, 2, A, 1, X, AF, 2, W, INFO )
00243 CALL CHKXER( 'DORMR2', INFOT, NOUT, LERR, OK )
00244 INFOT = 7
00245 CALL DORMR2( 'R', 'N', 1, 2, 2, A, 1, X, AF, 1, W, INFO )
00246 CALL CHKXER( 'DORMR2', INFOT, NOUT, LERR, OK )
00247 INFOT = 10
00248 CALL DORMR2( 'L', 'N', 2, 1, 0, A, 1, X, AF, 1, W, INFO )
00249 CALL CHKXER( 'DORMR2', INFOT, NOUT, LERR, OK )
00250
00251
00252
00253 CALL ALAESM( PATH, OK, NOUT )
00254
00255 RETURN
00256
00257
00258
00259 END