← Back to branch summary

~maddevelopers/mg5amcnlo/3.0.1

« back to all changes in this revision

Viewing changes to vendor/IREGI/src/oneloop/ONI/src/avh_oni_d1mach.f

  • Committer: Marco Zaro
  • Date: 2014-01-27 16:54:10 UTC
  • mfrom: (78.124.55 MG5_aMC_2.1)
  • Revision ID: marco.zaro@gmail.com-20140127165410-5lma8c2hzbzm426j
merged with lp:~maddevelopers/madgraph5/MG5_aMC_2.1 r 267

Show diffs side-by-side

added added

removed removed

Lines of Context:
vendor/IREGI/src/oneloop/ONI/src/avh_oni_d1mach.f
 
1
************************************************************************
 
2
* This is the file  avh_oni_d1mach.f  of the package                   *
 
3
*                                                                      *
 
4
*                  Oneloop with Numerical Integration                  *
 
5
*                                                                      *
 
6
* for the evaluation of 1-loop scalar 1-, 2-, 3- and 4-point functions *
 
7
*                                                                      *
 
8
* author: Andreas van Hameren <hamerenREMOVETHIS@ifj.edu.pl>           *
 
9
*   date: 28-07-2010                                                   *
 
10
************************************************************************
 
11
*                                                                      *
 
12
* Have a look at the file  avh_oni_hello.f  for more information.      *
 
13
*                                                                      *
 
14
************************************************************************
 
15
*                                                                      *
 
16
* Contains  function d1mach  plus dependencies from  port .            *
 
17
* Original obtained from netlib.org                                    *
 
18
*                                                                      *
 
19
* All function and subroutine names prepended with "avh_oni_"          *
 
20
*                                                                      *
 
21
************************************************************************
 
22
 
 
23
      DOUBLE PRECISION FUNCTION avh_oni_D1MACH(I)
 
24
      INTEGER I
 
25
C
 
26
C  DOUBLE-PRECISION MACHINE CONSTANTS
 
27
C  D1MACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE.
 
28
C  D1MACH( 2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE.
 
29
C  D1MACH( 3) = B**(-T), THE SMALLEST RELATIVE SPACING.
 
30
C  D1MACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING.
 
31
C  D1MACH( 5) = LOG10(B)
 
32
C
 
33
      INTEGER SMALL(2)
 
34
      INTEGER LARGE(2)
 
35
      INTEGER RIGHT(2)
 
36
      INTEGER DIVER(2)
 
37
      INTEGER LOG10(2)
 
38
      INTEGER SC, CRAY1(38), J
 
39
      COMMON /D9MACH/ CRAY1
 
40
      SAVE SMALL, LARGE, RIGHT, DIVER, LOG10, SC
 
41
      DOUBLE PRECISION DMACH(5)
 
42
      EQUIVALENCE (DMACH(1),SMALL(1))
 
43
      EQUIVALENCE (DMACH(2),LARGE(1))
 
44
      EQUIVALENCE (DMACH(3),RIGHT(1))
 
45
      EQUIVALENCE (DMACH(4),DIVER(1))
 
46
      EQUIVALENCE (DMACH(5),LOG10(1))
 
47
C  THIS VERSION ADAPTS AUTOMATICALLY TO MOST CURRENT MACHINES.
 
48
C  R1MACH CAN HANDLE AUTO-DOUBLE COMPILING, BUT THIS VERSION OF
 
49
C  D1MACH DOES NOT, BECAUSE WE DO NOT HAVE QUAD CONSTANTS FOR
 
50
C  MANY MACHINES YET.
 
51
C  TO COMPILE ON OLDER MACHINES, ADD A C IN COLUMN 1
 
52
C  ON THE NEXT LINE
 
53
      DATA SC/0/
 
54
C  AND REMOVE THE C FROM COLUMN 1 IN ONE OF THE SECTIONS BELOW.
 
55
C  CONSTANTS FOR EVEN OLDER MACHINES CAN BE OBTAINED BY
 
56
C          mail netlib@research.bell-labs.com
 
57
C          send old1mach from blas
 
58
C  PLEASE SEND CORRECTIONS TO dmg OR ehg@bell-labs.com.
 
59
C
 
60
C     MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES.
 
61
C      DATA SMALL(1),SMALL(2) / O402400000000, O000000000000 /
 
62
C      DATA LARGE(1),LARGE(2) / O376777777777, O777777777777 /
 
63
C      DATA RIGHT(1),RIGHT(2) / O604400000000, O000000000000 /
 
64
C      DATA DIVER(1),DIVER(2) / O606400000000, O000000000000 /
 
65
C      DATA LOG10(1),LOG10(2) / O776464202324, O117571775714 /, SC/987/
 
66
C
 
67
C     MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING
 
68
C     32-BIT INTEGERS.
 
69
C      DATA SMALL(1),SMALL(2) /    8388608,           0 /
 
70
C      DATA LARGE(1),LARGE(2) / 2147483647,          -1 /
 
71
C      DATA RIGHT(1),RIGHT(2) /  612368384,           0 /
 
72
C      DATA DIVER(1),DIVER(2) /  620756992,           0 /
 
73
C      DATA LOG10(1),LOG10(2) / 1067065498, -2063872008 /, SC/987/
 
74
C
 
75
C     MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES.
 
76
C      DATA SMALL(1),SMALL(2) / O000040000000, O000000000000 /
 
77
C      DATA LARGE(1),LARGE(2) / O377777777777, O777777777777 /
 
78
C      DATA RIGHT(1),RIGHT(2) / O170540000000, O000000000000 /
 
79
C      DATA DIVER(1),DIVER(2) / O170640000000, O000000000000 /
 
80
C      DATA LOG10(1),LOG10(2) / O177746420232, O411757177572 /, SC/987/
 
81
C
 
82
C     ON FIRST CALL, IF NO DATA UNCOMMENTED, TEST MACHINE TYPES.
 
83
      IF (SC .NE. 987) THEN
 
84
         DMACH(1) = 1.D13
 
85
         IF (      SMALL(1) .EQ. 1117925532
 
86
     *       .AND. SMALL(2) .EQ. -448790528) THEN
 
87
*           *** IEEE BIG ENDIAN ***
 
88
            SMALL(1) = 1048576
 
89
            SMALL(2) = 0
 
90
            LARGE(1) = 2146435071
 
91
            LARGE(2) = -1
 
92
            RIGHT(1) = 1017118720
 
93
            RIGHT(2) = 0
 
94
            DIVER(1) = 1018167296
 
95
            DIVER(2) = 0
 
96
            LOG10(1) = 1070810131
 
97
            LOG10(2) = 1352628735
 
98
         ELSE IF ( SMALL(2) .EQ. 1117925532
 
99
     *       .AND. SMALL(1) .EQ. -448790528) THEN
 
100
*           *** IEEE LITTLE ENDIAN ***
 
101
            SMALL(2) = 1048576
 
102
            SMALL(1) = 0
 
103
            LARGE(2) = 2146435071
 
104
            LARGE(1) = -1
 
105
            RIGHT(2) = 1017118720
 
106
            RIGHT(1) = 0
 
107
            DIVER(2) = 1018167296
 
108
            DIVER(1) = 0
 
109
            LOG10(2) = 1070810131
 
110
            LOG10(1) = 1352628735
 
111
         ELSE IF ( SMALL(1) .EQ. -2065213935
 
112
     *       .AND. SMALL(2) .EQ. 10752) THEN
 
113
*               *** VAX WITH D_FLOATING ***
 
114
            SMALL(1) = 128
 
115
            SMALL(2) = 0
 
116
            LARGE(1) = -32769
 
117
            LARGE(2) = -1
 
118
            RIGHT(1) = 9344
 
119
            RIGHT(2) = 0
 
120
            DIVER(1) = 9472
 
121
            DIVER(2) = 0
 
122
            LOG10(1) = 546979738
 
123
            LOG10(2) = -805796613
 
124
         ELSE IF ( SMALL(1) .EQ. 1267827943
 
125
     *       .AND. SMALL(2) .EQ. 704643072) THEN
 
126
*               *** IBM MAINFRAME ***
 
127
            SMALL(1) = 1048576
 
128
            SMALL(2) = 0
 
129
            LARGE(1) = 2147483647
 
130
            LARGE(2) = -1
 
131
            RIGHT(1) = 856686592
 
132
            RIGHT(2) = 0
 
133
            DIVER(1) = 873463808
 
134
            DIVER(2) = 0
 
135
            LOG10(1) = 1091781651
 
136
            LOG10(2) = 1352628735
 
137
         ELSE IF ( SMALL(1) .EQ. 1120022684
 
138
     *       .AND. SMALL(2) .EQ. -448790528) THEN
 
139
*           *** CONVEX C-1 ***
 
140
            SMALL(1) = 1048576
 
141
            SMALL(2) = 0
 
142
            LARGE(1) = 2147483647
 
143
            LARGE(2) = -1
 
144
            RIGHT(1) = 1019215872
 
145
            RIGHT(2) = 0
 
146
            DIVER(1) = 1020264448
 
147
            DIVER(2) = 0
 
148
            LOG10(1) = 1072907283
 
149
            LOG10(2) = 1352628735
 
150
         ELSE IF ( SMALL(1) .EQ. 815547074
 
151
     *       .AND. SMALL(2) .EQ. 58688) THEN
 
152
*           *** VAX G-FLOATING ***
 
153
            SMALL(1) = 16
 
154
            SMALL(2) = 0
 
155
            LARGE(1) = -32769
 
156
            LARGE(2) = -1
 
157
            RIGHT(1) = 15552
 
158
            RIGHT(2) = 0
 
159
            DIVER(1) = 15568
 
160
            DIVER(2) = 0
 
161
            LOG10(1) = 1142112243
 
162
            LOG10(2) = 2046775455
 
163
         ELSE
 
164
            DMACH(2) = 1.D27 + 1
 
165
            DMACH(3) = 1.D27
 
166
            LARGE(2) = LARGE(2) - RIGHT(2)
 
167
            IF (LARGE(2) .EQ. 64 .AND. SMALL(2) .EQ. 0) THEN
 
168
               CRAY1(1) = 67291416
 
169
               DO 10 J = 1, 20
 
170
                  CRAY1(J+1) = CRAY1(J) + CRAY1(J)
 
171
 10               CONTINUE
 
172
               CRAY1(22) = CRAY1(21) + 321322
 
173
               DO 20 J = 22, 37
 
174
                  CRAY1(J+1) = CRAY1(J) + CRAY1(J)
 
175
 20               CONTINUE
 
176
               IF (CRAY1(38) .EQ. SMALL(1)) THEN
 
177
*                  *** CRAY ***
 
178
          CALL avh_oni_I1MCRY(SMALL(1), J, 8285, 8388608, 0)
 
179
          SMALL(2) = 0
 
180
          CALL avh_oni_I1MCRY(LARGE(1), J, 24574, 16777215, 16777215)
 
181
          CALL avh_oni_I1MCRY(LARGE(2), J, 0, 16777215, 16777214)
 
182
          CALL avh_oni_I1MCRY(RIGHT(1), J, 16291, 8388608, 0)
 
183
          RIGHT(2) = 0
 
184
          CALL avh_oni_I1MCRY(DIVER(1), J, 16292, 8388608, 0)
 
185
          DIVER(2) = 0
 
186
          CALL avh_oni_I1MCRY(LOG10(1), J, 16383, 10100890, 8715215)
 
187
          CALL avh_oni_I1MCRY(LOG10(2), J, 0, 16226447, 9001388)
 
188
               ELSE
 
189
                  WRITE(*,9000)
 
190
                  STOP 779
 
191
                  END IF
 
192
            ELSE
 
193
               WRITE(*,9000)
 
194
               STOP 779
 
195
               END IF
 
196
            END IF
 
197
         SC = 987
 
198
         END IF
 
199
*    SANITY CHECK
 
200
      IF (DMACH(4) .GE. 1.0D0) STOP 778
 
201
      IF (I .LT. 1 .OR. I .GT. 5) THEN
 
202
         WRITE(*,*) 'D1MACH(I): I =',I,' is out of bounds.'
 
203
         STOP
 
204
         END IF
 
205
      avh_oni_D1MACH = DMACH(I)
 
206
      RETURN
 
207
 9000 FORMAT(/' Adjust D1MACH by uncommenting data statements'/
 
208
     *' appropriate for your machine.')
 
209
* /* Standard C source for D1MACH -- remove the * in column 1 */
 
210
*#include <stdio.h>
 
211
*#include <float.h>
 
212
*#include <math.h>
 
213
*double d1mach_(long *i)
 
214
*{
 
215
*       switch(*i){
 
216
*         case 1: return DBL_MIN;
 
217
*         case 2: return DBL_MAX;
 
218
*         case 3: return DBL_EPSILON/FLT_RADIX;
 
219
*         case 4: return DBL_EPSILON;
 
220
*         case 5: return log10((double)FLT_RADIX);
 
221
*         }
 
222
*       fprintf(stderr, "invalid argument: d1mach(%ld)\n", *i);
 
223
*       exit(1); return 0; /* some compilers demand return values */
 
224
*}
 
225
      END
 
226
      SUBROUTINE avh_oni_I1MCRY(A, A1, B, C, D)
 
227
**** SPECIAL COMPUTATION FOR OLD CRAY MACHINES ****
 
228
      INTEGER A, A1, B, C, D
 
229
      A1 = 16777216*B + C
 
230
      A = 16777216*A1 + D
 
231
      END