lxsd / fvn

Blame view

fvn_fnlib/i1mach.f90 4.12 KB
edit raw normal view history
38581db0c   daniau   git-svn-id: https... 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
 
  !DECK I1MACH
        INTEGER FUNCTION I1MACH (I)
        IMPLICIT NONE
        INTEGER :: I
        REAL :: X
        DOUBLE PRECISION :: XX
  !***BEGIN PROLOGUE  I1MACH
  !***PURPOSE  Return integer machine dependent constants.
  !***LIBRARY   SLATEC
  !***CATEGORY  R1
  !***TYPE      INTEGER (I1MACH-I)
  !***KEYWORDS  MACHINE CONSTANTS
  !***AUTHOR  Fox, P. A., (Bell Labs)
  !           Hall, A. D., (Bell Labs)
  !           Schryer, N. L., (Bell Labs)
  !***DESCRIPTION
  !
  !   I1MACH can be used to obtain machine-dependent parameters for the
  !   local machine environment.  It is a function subprogram with one
  !   (input) argument and can be referenced as follows:
  !
  !        K = I1MACH(I)
  !
  !   where I=1,...,16.  The (output) value of K above is determined by
  !   the (input) value of I.  The results for various values of I are
  !   discussed below.
  !
  !   I/O unit numbers:
  !     I1MACH( 1) = the standard input unit.
  !     I1MACH( 2) = the standard output unit.
  !     I1MACH( 3) = the standard punch unit.
  !     I1MACH( 4) = the standard error message unit.
  !
  !   Words:
  !     I1MACH( 5) = the number of bits per integer storage unit.
  !     I1MACH( 6) = the number of characters per integer storage unit.
  !
  !   Integers:
  !     assume integers are represented in the S-digit, base-A form
  !
  !                sign ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) )
  !
  !                where 0 .LE. X(I) .LT. A for I=0,...,S-1.
  !     I1MACH( 7) = A, the base.
  !     I1MACH( 8) = S, the number of base-A digits.
  !     I1MACH( 9) = A**S - 1, the largest magnitude.
  !
  !   Floating-Point Numbers:
  !     Assume floating-point numbers are represented in the T-digit,
  !     base-B form
  !                sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
  !
  !                where 0 .LE. X(I) .LT. B for I=1,...,T,
  !                0 .LT. X(1), and EMIN .LE. E .LE. EMAX.
  !     I1MACH(10) = B, the base.
  !
  !   Single-Precision:
  !     I1MACH(11) = T, the number of base-B digits.
  !     I1MACH(12) = EMIN, the smallest exponent E.
  !     I1MACH(13) = EMAX, the largest exponent E.
  !
  !   Double-Precision:
  !     I1MACH(14) = T, the number of base-B digits.
  !     I1MACH(15) = EMIN, the smallest exponent E.
  !     I1MACH(16) = EMAX, the largest exponent E.
  !
  !   To alter this function for a particular environment, the desired
  !   set of DATA statements should be activated by removing the C from
  !   column 1.  Also, the values of I1MACH(1) - I1MACH(4) should be
  !   checked for consistency with the local operating system.
  !
  !***REFERENCES  P. A. Fox, A. D. Hall and N. L. Schryer, Framework for
  !                 a portable library, ACM Transactions on Mathematical
  !                 Software 4, 2 (June 1978), pp. 177-188.
  !***ROUTINES CALLED  (NONE)
  !***REVISION HISTORY  (YYMMDD)
  !   750101  DATE WRITTEN
  !   960411  Modified for Fortran 90 (BE after suggestions by EHG).   
  !   980727  Modified value of I1MACH(6) (BE after suggestion by EHG).   
  !***END PROLOGUE  I1MACH
  !
        X  = 1.0      
        XX = 1.0D0
  
        SELECT CASE (I)
          CASE (1)
            I1MACH = 5 ! Input unit
          CASE (2)
            I1MACH = 6 ! Output unit
          CASE (3)
            I1MACH = 0 ! Punch unit is no longer used
          CASE (4)
            I1MACH = 0 ! Error message unit
          CASE (5)
            I1MACH = BIT_SIZE(I)
          CASE (6)
            I1MACH = 4            ! Characters per integer is hopefully no
                                  ! longer used. 
                                  ! If it is used it has to be set manually.
                                  ! The value 4 is correct on IEEE-machines.
          CASE (7)
            I1MACH = RADIX(1)
          CASE (8)
            I1MACH = BIT_SIZE(I) - 1
          CASE (9)
            I1MACH = HUGE(1)
          CASE (10)
            I1MACH = RADIX(X)
          CASE (11)
            I1MACH = DIGITS(X)
          CASE (12)
            I1MACH = MINEXPONENT(X)
          CASE (13)
            I1MACH = MAXEXPONENT(X)
          CASE (14)
            I1MACH = DIGITS(XX)
          CASE (15)
            I1MACH = MINEXPONENT(XX)
          CASE (16)
            I1MACH = MAXEXPONENT(XX) 
          CASE DEFAULT
            WRITE (*, FMT = 9000)
   9000     FORMAT ('1ERROR    1 IN I1MACH - I OUT OF BOUNDS')
            STOP
          END SELECT
        RETURN
        END