d4/dc6/lsametst_8f_source.html

00001       PROGRAM TEST1
00002 *
00003 *  -- LAPACK test routine (version 3.2) --
00004 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00005 *     November 2006
00006 *
00007 *     .. Local Scalars ..
00008       INTEGER            I1, I2
00009 *     ..
00010 *     .. External Functions ..
00011       LOGICAL            LSAME
00012       EXTERNAL           LSAME
00013 *     ..
00014 *     .. Intrinsic Functions ..
00015       INTRINSIC          ICHAR
00016 *     ..
00017 *     .. Executable Statements ..
00018 *
00019 *
00020 *     Determine the character set.
00021 *
00022       I1 = ICHAR( 'A' )
00023       I2 = ICHAR( 'a' )
00024       IF( I2-I1.EQ.32 ) THEN
00025          WRITE( *, * ) ' ASCII character set'
00026       ELSE
00027          WRITE( *, * ) ' Non-ASCII character set, IOFF should be ',I2-I1
00028       END IF
00029 *
00030 *     Test LSAME.
00031 *
00032       IF( .NOT.LSAME( 'A', 'A' ) )
00033      $   WRITE( *, 9999 )'A', 'A'
00034       IF( .NOT.LSAME( 'A', 'a' ) )
00035      $   WRITE( *, 9999 )'A', 'a'
00036       IF( .NOT.LSAME( 'a', 'A' ) )
00037      $   WRITE( *, 9999 )'a', 'A'
00038       IF( .NOT.LSAME( 'a', 'a' ) )
00039      $   WRITE( *, 9999 )'a', 'a'
00040       IF( LSAME( 'A', 'B' ) )
00041      $   WRITE( *, 9998 )'A', 'B'
00042       IF( LSAME( 'A', 'b' ) )
00043      $   WRITE( *, 9998 )'A', 'b'
00044       IF( LSAME( 'a', 'B' ) )
00045      $   WRITE( *, 9998 )'a', 'B'
00046       IF( LSAME( 'a', 'b' ) )
00047      $   WRITE( *, 9998 )'a', 'b'
00048       IF( LSAME( 'O', '/' ) )
00049      $   WRITE( *, 9998 )'O', '/'
00050       IF( LSAME( '/', 'O' ) )
00051      $   WRITE( *, 9998 )'/', 'O'
00052       IF( LSAME( 'o', '/' ) )
00053      $   WRITE( *, 9998 )'o', '/'
00054       IF( LSAME( '/', 'o' ) )
00055      $   WRITE( *, 9998 )'/', 'o'
00056       WRITE( *, * )' Tests completed'
00057 *
00058  9999 FORMAT( ' *** Error:  LSAME( ', A1, ', ', A1, ') is .FALSE.' )
00059  9998 FORMAT( ' *** Error:  LSAME( ', A1, ', ', A1, ') is .TRUE.' )
00060       END