![]() ![]() | ![]() |
Mise à jour de lapack vers la version 3.3.0.
1: LOGICAL FUNCTION LSAMEN( N, CA, CB ) 2: * 3: * -- LAPACK auxiliary routine (version 3.2) -- 4: * -- LAPACK is a software package provided by Univ. of Tennessee, -- 5: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 6: * November 2006 7: * 8: * .. Scalar Arguments .. 9: CHARACTER*( * ) CA, CB 10: INTEGER N 11: * .. 12: * 13: * Purpose 14: * ======= 15: * 16: * LSAMEN tests if the first N letters of CA are the same as the 17: * first N letters of CB, regardless of case. 18: * LSAMEN returns .TRUE. if CA and CB are equivalent except for case 19: * and .FALSE. otherwise. LSAMEN also returns .FALSE. if LEN( CA ) 20: * or LEN( CB ) is less than N. 21: * 22: * Arguments 23: * ========= 24: * 25: * N (input) INTEGER 26: * The number of characters in CA and CB to be compared. 27: * 28: * CA (input) CHARACTER*(*) 29: * CB (input) CHARACTER*(*) 30: * CA and CB specify two character strings of length at least N. 31: * Only the first N characters of each string will be accessed. 32: * 33: * ===================================================================== 34: * 35: * .. Local Scalars .. 36: INTEGER I 37: * .. 38: * .. External Functions .. 39: LOGICAL LSAME 40: EXTERNAL LSAME 41: * .. 42: * .. Intrinsic Functions .. 43: INTRINSIC LEN 44: * .. 45: * .. Executable Statements .. 46: * 47: LSAMEN = .FALSE. 48: IF( LEN( CA ).LT.N .OR. LEN( CB ).LT.N ) 49: $ GO TO 20 50: * 51: * Do for each character in the two strings. 52: * 53: DO 10 I = 1, N 54: * 55: * Test if the characters are equal using LSAME. 56: * 57: IF( .NOT.LSAME( CA( I: I ), CB( I: I ) ) ) 58: $ GO TO 20 59: * 60: 10 CONTINUE 61: LSAMEN = .TRUE. 62: * 63: 20 CONTINUE 64: RETURN 65: * 66: * End of LSAMEN 67: * 68: END