Télécharger la plaquette Cast3M


fr en

Télécharger lsame.eso

Retour à la liste

Numérotation des lignes : 

lsame

  1. C LSAME     SOURCE    BP208322  22/09/16    21:15:10     11454          
  2. *
  3. *  Purpose
  4. *  =======
  5. *
  6. *  LSAME returns .TRUE. if CA is the same letter as CB regardless of
  7. *  case.
  8. *
  9. *  Arguments
  10. *  =========
  11. *
  12. *  CA      (input) CHARACTER*1
  13. *  CB      (input) CHARACTER*1
  14. *          CA and CB specify the single characters to be compared.
  15. *
  16. * =====================================================================
  17.       FUNCTION LSAME( CA, CB )
  18.       IMPLICIT INTEGER(I-N)
  19.       IMPLICIT REAL*8 (A-H,O-Z)
  20. *
  21. *  -- LAPACK auxiliary routine (version 2.0) --
  22. *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
  23. *     Courant Institute, Argonne National Lab, and Rice University
  24. *     January 31, 1994
  25. *     Modified on 16/2/98 :  commented INTRINSIC (not esope compatible)
  26. *
  27. *     .. Scalar Result ..
  28.       LOGICAL LSAME
  29. *     .. Scalar Arguments ..
  30.       CHARACTER*1     CA, CB
  31. *     ..
  32. *
  33. * =====================================================================
  34. *
  35. *
  36. *     .. Intrinsic Functions ..
  37. *      INTRINSIC          ICHAR
  38. *     ..
  39. *     .. Local Scalars ..
  40.       INTEGER            INTA, INTB, ZCODE
  41. *     ..
  42. *     .. Executable Statements ..
  43. *
  44. *     Test if the characters are equal
  45. *
  46.       LSAME = CA .EQ. CB
  47.       IF (LSAME) RETURN
  48. *
  49. *     Now test for equivalence if both characters are alphabetic.
  50. *
  51.       ZCODE = ICHAR( 'Z' )
  52. *
  53. *     Use 'Z' rather than 'A' so that ASCII can be detected on Prime
  54. *     machines, on which ICHAR returns a value with bit 8 set.
  55. *     ICHAR('A') on Prime machines returns 193 which is the same as
  56. *     ICHAR('A') on an EBCDIC machine.
  57. *
  58.       INTA = ICHAR( CA )
  59.       INTB = ICHAR( CB )
  60. *
  61.       IF( ZCODE.EQ.90 .OR. ZCODE.EQ.122 ) THEN
  62. *
  63. *        ASCII is assumed - ZCODE is the ASCII code of either lower or
  64. *        upper case 'Z'.
  65. *
  66.          IF( INTA.GE.97 .AND. INTA.LE.122 ) INTA = INTA - 32
  67.          IF( INTB.GE.97 .AND. INTB.LE.122 ) INTB = INTB - 32
  68. *
  69.       ELSE IF( ZCODE.EQ.233 .OR. ZCODE.EQ.169 ) THEN
  70. *
  71. *        EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or
  72. *        upper case 'Z'.
  73. *
  74.          IF( INTA.GE.129 .AND. INTA.LE.137 .OR.
  75.      $        INTA.GE.145 .AND. INTA.LE.153 .OR.
  76.      $        INTA.GE.162 .AND. INTA.LE.169 ) INTA = INTA + 64
  77.          IF( INTB.GE.129 .AND. INTB.LE.137 .OR.
  78.      $        INTB.GE.145 .AND. INTB.LE.153 .OR.
  79.      $        INTB.GE.162 .AND. INTB.LE.169 ) INTB = INTB + 64
  80. *
  81.       ELSE IF( ZCODE.EQ.218 .OR. ZCODE.EQ.250 ) THEN
  82. *
  83. *        ASCII is assumed, on Prime machines - ZCODE is the ASCII code
  84. *        plus 128 of either lower or upper case 'Z'.
  85. *
  86.          IF( INTA.GE.225 .AND. INTA.LE.250 ) INTA = INTA - 32
  87.          IF( INTB.GE.225 .AND. INTB.LE.250 ) INTB = INTB - 32
  88.       END IF
  89.       LSAME = INTA.EQ.INTB
  90. *
  91.       RETURN
  92. *
  93. *     End of LSAME
  94. *
  95.       END
  96.  
  97.  
  98.  
  99.  
  100.  
  101.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales