00001 LOGICAL FUNCTION LSAMEN( N, CA, CB ) 00002 * 00003 * -- LAPACK auxiliary routine (version 3.2) -- 00004 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00005 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00006 * November 2006 00007 * 00008 * .. Scalar Arguments .. 00009 CHARACTER*( * ) CA, CB 00010 INTEGER N 00011 * .. 00012 * 00013 * Purpose 00014 * ======= 00015 * 00016 * LSAMEN tests if the first N letters of CA are the same as the 00017 * first N letters of CB, regardless of case. 00018 * LSAMEN returns .TRUE. if CA and CB are equivalent except for case 00019 * and .FALSE. otherwise. LSAMEN also returns .FALSE. if LEN( CA ) 00020 * or LEN( CB ) is less than N. 00021 * 00022 * Arguments 00023 * ========= 00024 * 00025 * N (input) INTEGER 00026 * The number of characters in CA and CB to be compared. 00027 * 00028 * CA (input) CHARACTER*(*) 00029 * CB (input) CHARACTER*(*) 00030 * CA and CB specify two character strings of length at least N. 00031 * Only the first N characters of each string will be accessed. 00032 * 00033 * ===================================================================== 00034 * 00035 * .. Local Scalars .. 00036 INTEGER I 00037 * .. 00038 * .. External Functions .. 00039 LOGICAL LSAME 00040 EXTERNAL LSAME 00041 * .. 00042 * .. Intrinsic Functions .. 00043 INTRINSIC LEN 00044 * .. 00045 * .. Executable Statements .. 00046 * 00047 LSAMEN = .FALSE. 00048 IF( LEN( CA ).LT.N .OR. LEN( CB ).LT.N ) 00049 $ GO TO 20 00050 * 00051 * Do for each character in the two strings. 00052 * 00053 DO 10 I = 1, N 00054 * 00055 * Test if the characters are equal using LSAME. 00056 * 00057 IF( .NOT.LSAME( CA( I: I ), CB( I: I ) ) ) 00058 $ GO TO 20 00059 * 00060 10 CONTINUE 00061 LSAMEN = .TRUE. 00062 * 00063 20 CONTINUE 00064 RETURN 00065 * 00066 * End of LSAMEN 00067 * 00068 END
1.7.2