source: LMDZ6/trunk/libf/misc/i1mach.f90 @ 5435

Last change on this file since 5435 was 5246, checked in by abarral, 2 months ago

Convert fixed-form to free-form sources .F -> .{f,F}90
(WIP: some .F remain, will be handled in subsequent commits)

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 4.4 KB
RevLine 
[5246]1!DECK I1MACH
2INTEGER FUNCTION I1MACH (I)
3  IMPLICIT NONE
4  !***BEGIN PROLOGUE  I1MACH
5  !***PURPOSE  Return integer machine dependent constants.
6  !***LIBRARY   SLATEC
7  !***CATEGORY  R1
8  !***TYPE      INTEGER (I1MACH-I)
9  !***KEYWORDS  MACHINE CONSTANTS
10  !***AUTHOR  Fox, P. A., (Bell Labs)
11        ! Hall, A. D., (Bell Labs)
12        ! Schryer, N. L., (Bell Labs)
13  !***DESCRIPTION
14  !
15  !   I1MACH can be used to obtain machine-dependent parameters for the
16  !   local machine environment.  It is a function subprogram with one
17  !   (input) argument and can be referenced as follows:
18  !
19  !    K = I1MACH(I)
20  !
21  !   where I=1,...,16.  The (output) value of K above is determined by
22  !   the (input) value of I.  The results for various values of I are
23  !   discussed below.
24  !
25  !   I/O unit numbers:
26  ! I1MACH( 1) = the standard input unit.
27  ! I1MACH( 2) = the standard output unit.
28  ! I1MACH( 3) = the standard punch unit.
29  ! I1MACH( 4) = the standard error message unit.
30  !
31  !   Words:
32  ! I1MACH( 5) = the number of bits per integer storage unit.
33  ! I1MACH( 6) = the number of characters per integer storage unit.
34  !
35  !   Integers:
36  ! assume integers are represented in the S-digit, base-A form
37  !
38  !            sign ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) )
39  !
40  !            where 0 .LE. X(I) .LT. A for I=0,...,S-1.
41  ! I1MACH( 7) = A, the base.
42  ! I1MACH( 8) = S, the number of base-A digits.
43  ! I1MACH( 9) = A**S - 1, the largest magnitude.
44  !
45  !   Floating-Point Numbers:
46  ! Assume floating-point numbers are represented in the T-digit,
47  ! base-B form
48  !            sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
49  !
50  !            where 0 .LE. X(I) .LT. B for I=1,...,T,
51  !            0 .LT. X(1), and EMIN .LE. E .LE. EMAX.
52  ! I1MACH(10) = B, the base.
53  !
54  !   Single-Precision:
55  ! I1MACH(11) = T, the number of base-B digits.
56  ! I1MACH(12) = EMIN, the smallest exponent E.
57  ! I1MACH(13) = EMAX, the largest exponent E.
58  !
59  !   Double-Precision:
60  ! I1MACH(14) = T, the number of base-B digits.
61  ! I1MACH(15) = EMIN, the smallest exponent E.
62  ! I1MACH(16) = EMAX, the largest exponent E.
63  !
64  !   To alter this function for a particular environment, the desired
65  !   set of DATA statements should be activated by removing the C from
66  !   column 1.  Also, the values of I1MACH(1) - I1MACH(4) should be
67  !   checked for consistency with the local operating system.
68  !
69  !***REFERENCES  P. A. Fox, A. D. Hall and N. L. Schryer, Framework for
70  !             a portable library, ACM Transactions on Mathematical
71  !             Software 4, 2 (June 1978), pp. 177-188.
72  !***ROUTINES CALLED  (NONE)
73  !***REVISION HISTORY  (YYMMDD)
74  !   750101  DATE WRITTEN
75  !   891012  Added VAX G-floating constants.  (WRB)
76  !   891012  REVISION DATE from Version 3.2
77  !   891214  Prologue converted to Version 4.0 format.  (BAB)
78  !   900618  Added DEC RISC constants.  (WRB)
79  !   900723  Added IBM RS 6000 constants.  (WRB)
80  !   901009  Correct I1MACH(7) for IBM Mainframes. Should be 2 not 16.
81  !       (RWC)
82  !   910710  Added HP 730 constants.  (SMR)
83  !   911114  Added Convex IEEE constants.  (WRB)
84  !   920121  Added SUN -r8 compiler option constants.  (WRB)
85  !   920229  Added Touchstone Delta i860 constants.  (WRB)
86  !   920501  Reformatted the REFERENCES section.  (WRB)
87  !   920625  Added Convex -p8 and -pd8 compiler option constants.
88  !       (BKS, WRB)
89  !   930201  Added DEC Alpha and SGI constants.  (RWC and WRB)
90  !   930618  Corrected I1MACH(5) for Convex -p8 and -pd8 compiler
91  !       options.  (DWL, RWC and WRB).
92  !   100623  Use Fortran 95 intrinsic functions (Lionel GUEZ)
93  !***END PROLOGUE  I1MACH
94  !
95  INTEGER :: IMACH(16),OUTPUT
96  SAVE IMACH
97  EQUIVALENCE (IMACH(4),OUTPUT)
98  INTEGER :: I
99  !***FIRST EXECUTABLE STATEMENT  I1MACH
100  IMACH( 1) =         5
101  IMACH( 2) =         6
102  IMACH( 3) =         6
103  IMACH( 4) =         6
104  IMACH( 5) =        bit_size(0)
105  IMACH( 6) =         IMACH( 5) / 8
106  IMACH( 7) =         radix(0)
107  IMACH( 8) =        digits(0)
108  IMACH( 9) =     huge(0)
109  IMACH(10) =         radix(0.)
110  IMACH(11) =        digits(0.)
111  IMACH(12) =      minexponent(0.)
112  IMACH(13) =       maxexponent(0.)
113  IMACH(14) =        digits(0d0)
114  IMACH(15) =      minexponent(0d0)
115  IMACH(16) =       maxexponent(0d0)
116  IF (I .LT. 1  .OR.  I .GT. 16) GO TO 10
117  !
118  I1MACH = IMACH(I)
119  RETURN
120  !
121   10   CONTINUE
122  WRITE (UNIT = OUTPUT, FMT = 9000)
123 9000   FORMAT ('1ERROR    1 IN I1MACH - I OUT OF BOUNDS')
124  !
125  ! CALL FDUMP
126  !
127  STOP
128END FUNCTION I1MACH
Note: See TracBrowser for help on using the repository browser.