Annotation of rpl/lapack/lapack/zhb2st_kernels.f, revision 1.5
1.1 bertrand 1: *> \brief \b ZHB2ST_KERNELS
2: *
3: * @precisions fortran z -> s d c
1.5 ! bertrand 4: *
1.1 bertrand 5: * =========== DOCUMENTATION ===========
6: *
1.5 ! bertrand 7: * Online html documentation available at
! 8: * http://www.netlib.org/lapack/explore-html/
1.1 bertrand 9: *
10: *> \htmlonly
1.5 ! bertrand 11: *> Download ZHB2ST_KERNELS + dependencies
! 12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhb2st_kernels.f">
! 13: *> [TGZ]</a>
! 14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhb2st_kernels.f">
! 15: *> [ZIP]</a>
! 16: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhb2st_kernels.f">
1.1 bertrand 17: *> [TXT]</a>
1.5 ! bertrand 18: *> \endhtmlonly
1.1 bertrand 19: *
20: * Definition:
21: * ===========
22: *
1.5 ! bertrand 23: * SUBROUTINE ZHB2ST_KERNELS( UPLO, WANTZ, TTYPE,
1.1 bertrand 24: * ST, ED, SWEEP, N, NB, IB,
25: * A, LDA, V, TAU, LDVT, WORK)
26: *
27: * IMPLICIT NONE
28: *
29: * .. Scalar Arguments ..
30: * CHARACTER UPLO
31: * LOGICAL WANTZ
32: * INTEGER TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT
33: * ..
34: * .. Array Arguments ..
1.5 ! bertrand 35: * COMPLEX*16 A( LDA, * ), V( * ),
1.1 bertrand 36: * TAU( * ), WORK( * )
1.5 ! bertrand 37: *
1.1 bertrand 38: *> \par Purpose:
39: * =============
40: *>
41: *> \verbatim
42: *>
43: *> ZHB2ST_KERNELS is an internal routine used by the ZHETRD_HB2ST
44: *> subroutine.
45: *> \endverbatim
46: *
47: * Arguments:
48: * ==========
49: *
1.3 bertrand 50: *> \param[in] UPLO
51: *> \verbatim
52: *> UPLO is CHARACTER*1
53: *> \endverbatim
54: *>
55: *> \param[in] WANTZ
56: *> \verbatim
57: *> WANTZ is LOGICAL which indicate if Eigenvalue are requested or both
58: *> Eigenvalue/Eigenvectors.
59: *> \endverbatim
60: *>
61: *> \param[in] TTYPE
62: *> \verbatim
63: *> TTYPE is INTEGER
64: *> \endverbatim
65: *>
66: *> \param[in] ST
67: *> \verbatim
68: *> ST is INTEGER
69: *> internal parameter for indices.
70: *> \endverbatim
1.1 bertrand 71: *>
1.3 bertrand 72: *> \param[in] ED
73: *> \verbatim
74: *> ED is INTEGER
75: *> internal parameter for indices.
76: *> \endverbatim
1.1 bertrand 77: *>
1.3 bertrand 78: *> \param[in] SWEEP
79: *> \verbatim
80: *> SWEEP is INTEGER
81: *> internal parameter for indices.
82: *> \endverbatim
1.1 bertrand 83: *>
1.3 bertrand 84: *> \param[in] N
85: *> \verbatim
86: *> N is INTEGER. The order of the matrix A.
87: *> \endverbatim
1.1 bertrand 88: *>
1.3 bertrand 89: *> \param[in] NB
90: *> \verbatim
91: *> NB is INTEGER. The size of the band.
92: *> \endverbatim
1.1 bertrand 93: *>
1.3 bertrand 94: *> \param[in] IB
95: *> \verbatim
96: *> IB is INTEGER.
97: *> \endverbatim
1.1 bertrand 98: *>
1.3 bertrand 99: *> \param[in, out] A
100: *> \verbatim
101: *> A is COMPLEX*16 array. A pointer to the matrix A.
102: *> \endverbatim
1.1 bertrand 103: *>
1.3 bertrand 104: *> \param[in] LDA
105: *> \verbatim
106: *> LDA is INTEGER. The leading dimension of the matrix A.
107: *> \endverbatim
1.1 bertrand 108: *>
1.3 bertrand 109: *> \param[out] V
110: *> \verbatim
111: *> V is COMPLEX*16 array, dimension 2*n if eigenvalues only are
112: *> requested or to be queried for vectors.
113: *> \endverbatim
1.1 bertrand 114: *>
1.3 bertrand 115: *> \param[out] TAU
116: *> \verbatim
117: *> TAU is COMPLEX*16 array, dimension (2*n).
118: *> The scalar factors of the Householder reflectors are stored
119: *> in this array.
120: *> \endverbatim
1.1 bertrand 121: *>
1.3 bertrand 122: *> \param[in] LDVT
123: *> \verbatim
124: *> LDVT is INTEGER.
125: *> \endverbatim
1.1 bertrand 126: *>
1.5 ! bertrand 127: *> \param[out] WORK
1.3 bertrand 128: *> \verbatim
129: *> WORK is COMPLEX*16 array. Workspace of size nb.
130: *> \endverbatim
1.1 bertrand 131: *>
132: *> \par Further Details:
133: * =====================
134: *>
135: *> \verbatim
136: *>
137: *> Implemented by Azzam Haidar.
138: *>
139: *> All details are available on technical report, SC11, SC13 papers.
140: *>
141: *> Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
142: *> Parallel reduction to condensed forms for symmetric eigenvalue problems
143: *> using aggregated fine-grained and memory-aware kernels. In Proceedings
144: *> of 2011 International Conference for High Performance Computing,
145: *> Networking, Storage and Analysis (SC '11), New York, NY, USA,
146: *> Article 8 , 11 pages.
147: *> http://doi.acm.org/10.1145/2063384.2063394
148: *>
149: *> A. Haidar, J. Kurzak, P. Luszczek, 2013.
1.5 ! bertrand 150: *> An improved parallel singular value algorithm and its implementation
1.1 bertrand 151: *> for multicore hardware, In Proceedings of 2013 International Conference
152: *> for High Performance Computing, Networking, Storage and Analysis (SC '13).
153: *> Denver, Colorado, USA, 2013.
154: *> Article 90, 12 pages.
155: *> http://doi.acm.org/10.1145/2503210.2503292
156: *>
157: *> A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
1.5 ! bertrand 158: *> A novel hybrid CPU-GPU generalized eigensolver for electronic structure
1.1 bertrand 159: *> calculations based on fine-grained memory aware tasks.
160: *> International Journal of High Performance Computing Applications.
161: *> Volume 28 Issue 2, Pages 196-209, May 2014.
1.5 ! bertrand 162: *> http://hpc.sagepub.com/content/28/2/196
1.1 bertrand 163: *>
164: *> \endverbatim
165: *>
166: * =====================================================================
1.5 ! bertrand 167: SUBROUTINE ZHB2ST_KERNELS( UPLO, WANTZ, TTYPE,
1.1 bertrand 168: $ ST, ED, SWEEP, N, NB, IB,
169: $ A, LDA, V, TAU, LDVT, WORK)
170: *
171: IMPLICIT NONE
172: *
1.3 bertrand 173: * -- LAPACK computational routine (version 3.7.1) --
1.1 bertrand 174: * -- LAPACK is a software package provided by Univ. of Tennessee, --
175: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.3 bertrand 176: * June 2017
1.1 bertrand 177: *
178: * .. Scalar Arguments ..
179: CHARACTER UPLO
180: LOGICAL WANTZ
181: INTEGER TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT
182: * ..
183: * .. Array Arguments ..
1.5 ! bertrand 184: COMPLEX*16 A( LDA, * ), V( * ),
1.1 bertrand 185: $ TAU( * ), WORK( * )
186: * ..
187: *
188: * =====================================================================
189: *
190: * .. Parameters ..
191: COMPLEX*16 ZERO, ONE
192: PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ),
193: $ ONE = ( 1.0D+0, 0.0D+0 ) )
194: * ..
195: * .. Local Scalars ..
196: LOGICAL UPPER
197: INTEGER I, J1, J2, LM, LN, VPOS, TAUPOS,
1.5 ! bertrand 198: $ DPOS, OFDPOS, AJETER
! 199: COMPLEX*16 CTMP
1.1 bertrand 200: * ..
201: * .. External Subroutines ..
202: EXTERNAL ZLARFG, ZLARFX, ZLARFY
203: * ..
204: * .. Intrinsic Functions ..
205: INTRINSIC DCONJG, MOD
206: * .. External Functions ..
207: LOGICAL LSAME
208: EXTERNAL LSAME
209: * ..
210: * ..
211: * .. Executable Statements ..
1.5 ! bertrand 212: *
1.1 bertrand 213: AJETER = IB + LDVT
214: UPPER = LSAME( UPLO, 'U' )
215:
216: IF( UPPER ) THEN
217: DPOS = 2 * NB + 1
218: OFDPOS = 2 * NB
219: ELSE
220: DPOS = 1
221: OFDPOS = 2
222: ENDIF
223:
224: *
225: * Upper case
226: *
227: IF( UPPER ) THEN
228: *
229: IF( WANTZ ) THEN
230: VPOS = MOD( SWEEP-1, 2 ) * N + ST
231: TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
232: ELSE
233: VPOS = MOD( SWEEP-1, 2 ) * N + ST
234: TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
235: ENDIF
236: *
237: IF( TTYPE.EQ.1 ) THEN
238: LM = ED - ST + 1
239: *
240: V( VPOS ) = ONE
241: DO 10 I = 1, LM-1
242: V( VPOS+I ) = DCONJG( A( OFDPOS-I, ST+I ) )
1.5 ! bertrand 243: A( OFDPOS-I, ST+I ) = ZERO
1.1 bertrand 244: 10 CONTINUE
245: CTMP = DCONJG( A( OFDPOS, ST ) )
1.5 ! bertrand 246: CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1,
1.1 bertrand 247: $ TAU( TAUPOS ) )
248: A( OFDPOS, ST ) = CTMP
249: *
250: LM = ED - ST + 1
251: CALL ZLARFY( UPLO, LM, V( VPOS ), 1,
252: $ DCONJG( TAU( TAUPOS ) ),
253: $ A( DPOS, ST ), LDA-1, WORK)
254: ENDIF
255: *
256: IF( TTYPE.EQ.3 ) THEN
257: *
258: LM = ED - ST + 1
259: CALL ZLARFY( UPLO, LM, V( VPOS ), 1,
260: $ DCONJG( TAU( TAUPOS ) ),
261: $ A( DPOS, ST ), LDA-1, WORK)
262: ENDIF
263: *
264: IF( TTYPE.EQ.2 ) THEN
265: J1 = ED+1
266: J2 = MIN( ED+NB, N )
267: LN = ED-ST+1
268: LM = J2-J1+1
269: IF( LM.GT.0) THEN
270: CALL ZLARFX( 'Left', LN, LM, V( VPOS ),
271: $ DCONJG( TAU( TAUPOS ) ),
272: $ A( DPOS-NB, J1 ), LDA-1, WORK)
273: *
274: IF( WANTZ ) THEN
275: VPOS = MOD( SWEEP-1, 2 ) * N + J1
276: TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
277: ELSE
278: VPOS = MOD( SWEEP-1, 2 ) * N + J1
279: TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
280: ENDIF
281: *
282: V( VPOS ) = ONE
283: DO 30 I = 1, LM-1
1.5 ! bertrand 284: V( VPOS+I ) =
1.1 bertrand 285: $ DCONJG( A( DPOS-NB-I, J1+I ) )
286: A( DPOS-NB-I, J1+I ) = ZERO
287: 30 CONTINUE
288: CTMP = DCONJG( A( DPOS-NB, J1 ) )
289: CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) )
290: A( DPOS-NB, J1 ) = CTMP
1.5 ! bertrand 291: *
1.1 bertrand 292: CALL ZLARFX( 'Right', LN-1, LM, V( VPOS ),
293: $ TAU( TAUPOS ),
294: $ A( DPOS-NB+1, J1 ), LDA-1, WORK)
295: ENDIF
296: ENDIF
297: *
298: * Lower case
1.5 ! bertrand 299: *
1.1 bertrand 300: ELSE
1.5 ! bertrand 301: *
1.1 bertrand 302: IF( WANTZ ) THEN
303: VPOS = MOD( SWEEP-1, 2 ) * N + ST
304: TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
305: ELSE
306: VPOS = MOD( SWEEP-1, 2 ) * N + ST
307: TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
308: ENDIF
309: *
310: IF( TTYPE.EQ.1 ) THEN
311: LM = ED - ST + 1
312: *
313: V( VPOS ) = ONE
314: DO 20 I = 1, LM-1
315: V( VPOS+I ) = A( OFDPOS+I, ST-1 )
1.5 ! bertrand 316: A( OFDPOS+I, ST-1 ) = ZERO
1.1 bertrand 317: 20 CONTINUE
1.5 ! bertrand 318: CALL ZLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1,
1.1 bertrand 319: $ TAU( TAUPOS ) )
320: *
321: LM = ED - ST + 1
322: *
323: CALL ZLARFY( UPLO, LM, V( VPOS ), 1,
324: $ DCONJG( TAU( TAUPOS ) ),
325: $ A( DPOS, ST ), LDA-1, WORK)
326:
327: ENDIF
328: *
329: IF( TTYPE.EQ.3 ) THEN
330: LM = ED - ST + 1
331: *
332: CALL ZLARFY( UPLO, LM, V( VPOS ), 1,
333: $ DCONJG( TAU( TAUPOS ) ),
334: $ A( DPOS, ST ), LDA-1, WORK)
335:
336: ENDIF
337: *
338: IF( TTYPE.EQ.2 ) THEN
339: J1 = ED+1
340: J2 = MIN( ED+NB, N )
341: LN = ED-ST+1
342: LM = J2-J1+1
343: *
344: IF( LM.GT.0) THEN
1.5 ! bertrand 345: CALL ZLARFX( 'Right', LM, LN, V( VPOS ),
1.1 bertrand 346: $ TAU( TAUPOS ), A( DPOS+NB, ST ),
347: $ LDA-1, WORK)
348: *
349: IF( WANTZ ) THEN
350: VPOS = MOD( SWEEP-1, 2 ) * N + J1
351: TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
352: ELSE
353: VPOS = MOD( SWEEP-1, 2 ) * N + J1
354: TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
355: ENDIF
356: *
357: V( VPOS ) = ONE
358: DO 40 I = 1, LM-1
359: V( VPOS+I ) = A( DPOS+NB+I, ST )
360: A( DPOS+NB+I, ST ) = ZERO
361: 40 CONTINUE
1.5 ! bertrand 362: CALL ZLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1,
1.1 bertrand 363: $ TAU( TAUPOS ) )
364: *
1.5 ! bertrand 365: CALL ZLARFX( 'Left', LM, LN-1, V( VPOS ),
1.1 bertrand 366: $ DCONJG( TAU( TAUPOS ) ),
367: $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK)
1.5 ! bertrand 368:
1.1 bertrand 369: ENDIF
370: ENDIF
371: ENDIF
372: *
373: RETURN
374: *
375: * END OF ZHB2ST_KERNELS
376: *
1.5 ! bertrand 377: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zhb2st_kernels.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack