LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ cmake()

subroutine cmake ( character*2  TYPE,
character*1  UPLO,
character*1  DIAG,
integer  M,
integer  N,
complex, dimension( nmax, * )  A,
integer  NMAX,
complex, dimension( * )  AA,
integer  LDA,
integer  KL,
integer  KU,
logical  RESET,
complex  TRANSL 
)

Definition at line 2741 of file c_cblat2.f.

2743*
2744* Generates values for an M by N matrix A within the bandwidth
2745* defined by KL and KU.
2746* Stores the values in the array AA in the data structure required
2747* by the routine, with unwanted elements set to rogue value.
2748*
2749* TYPE is 'ge', 'gb', 'he', 'hb', 'hp', 'tr', 'tb' OR 'tp'.
2750*
2751* Auxiliary routine for test program for Level 2 Blas.
2752*
2753* -- Written on 10-August-1987.
2754* Richard Hanson, Sandia National Labs.
2755* Jeremy Du Croz, NAG Central Office.
2756*
2757* .. Parameters ..
2758 COMPLEX ZERO, ONE
2759 parameter( zero = ( 0.0, 0.0 ), one = ( 1.0, 0.0 ) )
2760 COMPLEX ROGUE
2761 parameter( rogue = ( -1.0e10, 1.0e10 ) )
2762 REAL RZERO
2763 parameter( rzero = 0.0 )
2764 REAL RROGUE
2765 parameter( rrogue = -1.0e10 )
2766* .. Scalar Arguments ..
2767 COMPLEX TRANSL
2768 INTEGER KL, KU, LDA, M, N, NMAX
2769 LOGICAL RESET
2770 CHARACTER*1 DIAG, UPLO
2771 CHARACTER*2 TYPE
2772* .. Array Arguments ..
2773 COMPLEX A( NMAX, * ), AA( * )
2774* .. Local Scalars ..
2775 INTEGER I, I1, I2, I3, IBEG, IEND, IOFF, J, JJ, KK
2776 LOGICAL GEN, LOWER, SYM, TRI, UNIT, UPPER
2777* .. External Functions ..
2778 COMPLEX CBEG
2779 EXTERNAL cbeg
2780* .. Intrinsic Functions ..
2781 INTRINSIC cmplx, conjg, max, min, real
2782* .. Executable Statements ..
2783 gen = TYPE( 1: 1 ).EQ.'g'
2784 sym = TYPE( 1: 1 ).EQ.'h'
2785 tri = TYPE( 1: 1 ).EQ.'t'
2786 upper = ( sym.OR.tri ).AND.uplo.EQ.'U'
2787 lower = ( sym.OR.tri ).AND.uplo.EQ.'L'
2788 unit = tri.AND.diag.EQ.'U'
2789*
2790* Generate data in array A.
2791*
2792 DO 20 j = 1, n
2793 DO 10 i = 1, m
2794 IF( gen.OR.( upper.AND.i.LE.j ).OR.( lower.AND.i.GE.j ) )
2795 $ THEN
2796 IF( ( i.LE.j.AND.j - i.LE.ku ).OR.
2797 $ ( i.GE.j.AND.i - j.LE.kl ) )THEN
2798 a( i, j ) = cbeg( reset ) + transl
2799 ELSE
2800 a( i, j ) = zero
2801 END IF
2802 IF( i.NE.j )THEN
2803 IF( sym )THEN
2804 a( j, i ) = conjg( a( i, j ) )
2805 ELSE IF( tri )THEN
2806 a( j, i ) = zero
2807 END IF
2808 END IF
2809 END IF
2810 10 CONTINUE
2811 IF( sym )
2812 $ a( j, j ) = cmplx( real( a( j, j ) ), rzero )
2813 IF( tri )
2814 $ a( j, j ) = a( j, j ) + one
2815 IF( unit )
2816 $ a( j, j ) = one
2817 20 CONTINUE
2818*
2819* Store elements in array AS in data structure required by routine.
2820*
2821 IF( type.EQ.'ge' )THEN
2822 DO 50 j = 1, n
2823 DO 30 i = 1, m
2824 aa( i + ( j - 1 )*lda ) = a( i, j )
2825 30 CONTINUE
2826 DO 40 i = m + 1, lda
2827 aa( i + ( j - 1 )*lda ) = rogue
2828 40 CONTINUE
2829 50 CONTINUE
2830 ELSE IF( type.EQ.'gb' )THEN
2831 DO 90 j = 1, n
2832 DO 60 i1 = 1, ku + 1 - j
2833 aa( i1 + ( j - 1 )*lda ) = rogue
2834 60 CONTINUE
2835 DO 70 i2 = i1, min( kl + ku + 1, ku + 1 + m - j )
2836 aa( i2 + ( j - 1 )*lda ) = a( i2 + j - ku - 1, j )
2837 70 CONTINUE
2838 DO 80 i3 = i2, lda
2839 aa( i3 + ( j - 1 )*lda ) = rogue
2840 80 CONTINUE
2841 90 CONTINUE
2842 ELSE IF( type.EQ.'he'.OR.type.EQ.'tr' )THEN
2843 DO 130 j = 1, n
2844 IF( upper )THEN
2845 ibeg = 1
2846 IF( unit )THEN
2847 iend = j - 1
2848 ELSE
2849 iend = j
2850 END IF
2851 ELSE
2852 IF( unit )THEN
2853 ibeg = j + 1
2854 ELSE
2855 ibeg = j
2856 END IF
2857 iend = n
2858 END IF
2859 DO 100 i = 1, ibeg - 1
2860 aa( i + ( j - 1 )*lda ) = rogue
2861 100 CONTINUE
2862 DO 110 i = ibeg, iend
2863 aa( i + ( j - 1 )*lda ) = a( i, j )
2864 110 CONTINUE
2865 DO 120 i = iend + 1, lda
2866 aa( i + ( j - 1 )*lda ) = rogue
2867 120 CONTINUE
2868 IF( sym )THEN
2869 jj = j + ( j - 1 )*lda
2870 aa( jj ) = cmplx( real( aa( jj ) ), rrogue )
2871 END IF
2872 130 CONTINUE
2873 ELSE IF( type.EQ.'hb'.OR.type.EQ.'tb' )THEN
2874 DO 170 j = 1, n
2875 IF( upper )THEN
2876 kk = kl + 1
2877 ibeg = max( 1, kl + 2 - j )
2878 IF( unit )THEN
2879 iend = kl
2880 ELSE
2881 iend = kl + 1
2882 END IF
2883 ELSE
2884 kk = 1
2885 IF( unit )THEN
2886 ibeg = 2
2887 ELSE
2888 ibeg = 1
2889 END IF
2890 iend = min( kl + 1, 1 + m - j )
2891 END IF
2892 DO 140 i = 1, ibeg - 1
2893 aa( i + ( j - 1 )*lda ) = rogue
2894 140 CONTINUE
2895 DO 150 i = ibeg, iend
2896 aa( i + ( j - 1 )*lda ) = a( i + j - kk, j )
2897 150 CONTINUE
2898 DO 160 i = iend + 1, lda
2899 aa( i + ( j - 1 )*lda ) = rogue
2900 160 CONTINUE
2901 IF( sym )THEN
2902 jj = kk + ( j - 1 )*lda
2903 aa( jj ) = cmplx( real( aa( jj ) ), rrogue )
2904 END IF
2905 170 CONTINUE
2906 ELSE IF( type.EQ.'hp'.OR.type.EQ.'tp' )THEN
2907 ioff = 0
2908 DO 190 j = 1, n
2909 IF( upper )THEN
2910 ibeg = 1
2911 iend = j
2912 ELSE
2913 ibeg = j
2914 iend = n
2915 END IF
2916 DO 180 i = ibeg, iend
2917 ioff = ioff + 1
2918 aa( ioff ) = a( i, j )
2919 IF( i.EQ.j )THEN
2920 IF( unit )
2921 $ aa( ioff ) = rogue
2922 IF( sym )
2923 $ aa( ioff ) = cmplx( real( aa( ioff ) ), rrogue )
2924 END IF
2925 180 CONTINUE
2926 190 CONTINUE
2927 END IF
2928 RETURN
2929*
2930* End of CMAKE.
2931*
complex function cbeg(RESET)
Definition: cblat2.f:3156