Télécharger la plaquette Cast3M


fr en

Télécharger zegale.eso

Retour à la liste

Numérotation des lignes : 

zegale

  1. C ZEGALE    SOURCE    CB215821  22/11/16    21:15:05     11500          
  2. C TBFCT     SOURCE    CHAT      05/01/13    03:32:55     5004
  3. *-------------------------------------------
  4. *  TEST SI 2 REELS SONT EGAUX A UNE CERTAINE
  5. *     PRECISION PRES.
  6. *-------------------------------------------
  7.         LOGICAL FUNCTION ZEGALE (X,Y,EPSILN)
  8.  
  9. *
  10. *  DEFINITION DES VARIABLES
  11. *
  12.       IMPLICIT INTEGER(I-N)
  13.         REAL*8  X,Y,EPSILN
  14. *
  15.         ZEGALE =  ( ( (X-Y)* (X-Y)).LE. (EPSILN*EPSILN))
  16. *
  17.         END
  18. *
  19.  
  20. *-------------------------------------------
  21. *  Convertie une chaine en entier
  22. *-------------------------------------------
  23.         INTEGER FUNCTION F_ATOI  ( CHAINE )
  24. *
  25.       IMPLICIT INTEGER(I-N)
  26.         character* (*)  chaine
  27.         read  (chaine,FMT=' (I9)') f_atoi
  28.         end
  29. *
  30. *-------------------------------------------
  31. *  Convertie un entier en chaine
  32. *-------------------------------------------
  33.         CHARACTER*10 FUNCTION F_ITOA  ( IVAL )
  34. *
  35.       IMPLICIT INTEGER(I-N)
  36.         integer ival
  37.         write  (f_itoa,FMT=' (I9)') ival
  38.         end
  39. *
  40. *-------------------------------------------
  41. *  Convertie une chaine en real*8
  42. *-------------------------------------------
  43.         FUNCTION  F_ATOL  ( CHAINE )
  44.       IMPLICIT INTEGER(I-N)
  45.         real*8 f_atol
  46. *
  47.         character* (*)  chaine
  48.         read  (chaine,FMT=' (G10.3)') f_atol
  49.         end
  50. *
  51. *-------------------------------------------
  52. *  Convertie un reel en chaine
  53. *-------------------------------------------
  54.         CHARACTER*10  FUNCTION  F_LTOA  ( RVAL )
  55. *
  56.       IMPLICIT INTEGER(I-N)
  57.         real*8  rval
  58.         write  (f_ltoa,FMT=' (G10.3)') rval
  59.         end
  60. *
  61. *-------------------------------------------
  62. *  TEST DEUX ELEMENTS SUIVANT UN CODE
  63. *-------------------------------------------
  64.         LOGICAL FUNCTION ZTEST ( CA, CB, TNUM)
  65. *
  66. *  DEFINITION DES VARIABLES
  67.       IMPLICIT INTEGER(I-N)
  68. -INC TMNTAB
  69.         INTEGER         TNUM
  70.         CHARACTER*30    CA,CB
  71.         INTEGER         IA,IB
  72.         REAL*8          RA,RB
  73. *
  74.         IF  (TNUM.EQ.1) THEN
  75.           RA = F_ATOL  (CA)
  76.           RB = F_ATOL  (CB)
  77.           ZTEST = RA.LT.RB
  78.           RETURN
  79.         ENDIF
  80.  
  81.         IF  (TNUM.EQ.2) THEN
  82.           RA = F_ATOL  (CA)
  83.           RB = F_ATOL  (CB)
  84.           ZTEST = RA.GT.RB
  85.           RETURN
  86.         ENDIF
  87.  
  88.         IF  (TNUM.EQ.3) THEN
  89.           ZTEST = LLT (CA,CB)
  90.           RETURN
  91.         ENDIF
  92.  
  93.         IF  (TNUM.EQ.4) THEN
  94.           ZTEST = LGT (CA,CB)
  95.           RETURN
  96.         ENDIF
  97.  
  98.         IF  (TNUM.EQ.5) THEN
  99.           IA = F_ATOI  (CA)
  100.           IB = F_ATOI  (CB)
  101.           ZTEST = IA.LT.IB
  102.           RETURN
  103.         ENDIF
  104.  
  105.         IF  (TNUM.EQ.6) THEN
  106.           IA = F_ATOI  (CA)
  107.           IB = F_ATOI  (CB)
  108.           ZTEST = IA.GT.IB
  109.           RETURN
  110.         ENDIF
  111.  
  112.         ZTEST = .FALSE.
  113. *
  114.         END
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  

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