56 IMPLICIT NONE
57
58
59
60
61
62
63 CHARACTER(LEN=3) PATH
64 INTEGER NUNIT
65
66
67
68
69
70 INTEGER NMAX
71 parameter( nmax = 2 )
72
73
74 INTEGER I, INFO, J
75
76
77 REAL A( NMAX, NMAX ), T( NMAX, NMAX ), D(NMAX)
78
79
81
82
83 LOGICAL LERR, OK
84 CHARACTER(LEN=32) SRNAMT
85 INTEGER INFOT, NOUT
86
87
88 COMMON / infoc / infot, nout, ok, lerr
89 COMMON / srnamc / srnamt
90
91
92 INTRINSIC real
93
94
95
96 nout = nunit
97 WRITE( nout, fmt = * )
98
99
100
101 DO j = 1, nmax
102 DO i = 1, nmax
103 a( i, j ) = 1.e+0 / real( i+j )
104 t( i, j ) = 1.e+0 / real( i+j )
105 END DO
106 d( j ) = 0.e+0
107 END DO
108 ok = .true.
109
110
111
112
113
114 srnamt = 'SORHR_COL'
115
116 infot = 1
117 CALL sorhr_col( -1, 0, 1, a, 1, t, 1, d, info )
118 CALL chkxer(
'SORHR_COL', infot, nout, lerr, ok )
119
120 infot = 2
121 CALL sorhr_col( 0, -1, 1, a, 1, t, 1, d, info )
122 CALL chkxer(
'SORHR_COL', infot, nout, lerr, ok )
123 CALL sorhr_col( 1, 2, 1, a, 1, t, 1, d, info )
124 CALL chkxer(
'SORHR_COL', infot, nout, lerr, ok )
125
126 infot = 3
127 CALL sorhr_col( 0, 0, -1, a, 1, t, 1, d, info )
128 CALL chkxer(
'SORHR_COL', infot, nout, lerr, ok )
129
130 CALL sorhr_col( 0, 0, 0, a, 1, t, 1, d, info )
131 CALL chkxer(
'SORHR_COL', infot, nout, lerr, ok )
132
133 infot = 5
134 CALL sorhr_col( 0, 0, 1, a, -1, t, 1, d, info )
135 CALL chkxer(
'SORHR_COL', infot, nout, lerr, ok )
136
137 CALL sorhr_col( 0, 0, 1, a, 0, t, 1, d, info )
138 CALL chkxer(
'SORHR_COL', infot, nout, lerr, ok )
139
140 CALL sorhr_col( 2, 0, 1, a, 1, t, 1, d, info )
141 CALL chkxer(
'SORHR_COL', infot, nout, lerr, ok )
142
143 infot = 7
144 CALL sorhr_col( 0, 0, 1, a, 1, t, -1, d, info )
145 CALL chkxer(
'SORHR_COL', infot, nout, lerr, ok )
146
147 CALL sorhr_col( 0, 0, 1, a, 1, t, 0, d, info )
148 CALL chkxer(
'SORHR_COL', infot, nout, lerr, ok )
149
150 CALL sorhr_col( 4, 3, 2, a, 4, t, 1, d, info )
151 CALL chkxer(
'SORHR_COL', infot, nout, lerr, ok )
152
153
154
155 CALL alaesm( path, ok, nout )
156
157 RETURN
158
159
160
subroutine alaesm(path, ok, nout)
ALAESM
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine sorhr_col(m, n, nb, a, lda, t, ldt, d, info)
SORHR_COL