4000.11. FORTRAN Code for coupling constants with QUAD precision output (28 to 31 decimal digits precision).
This FORTRAN code computes coupling constants from K-39.0 to K+18.5
PROGRAM ALFA_GENERAL
IMPLICIT NONE
COMPLEX*32 EXPM, ALFA_MINUS_HALF, ALFA_SQUARE
COMPLEX*32 ALFA_FINAL, C_0, C_87, C_8
REAL*16 B_1, B_2, B_3
REAL*16 C_1, C_2
COMPLEX*32 A, B, C
COMPLEX*32 ALFA_MINUS_HALF_1, ALFA_MINUS_HALF_3
REAL*16 ALFA_MINUS_HALF_2
REAL*16 REAL_PART, ABSOL_VALUE
COMPLEX*32 IMAG_PART
COMPLEX*32 THETA, THETA_DEG
C REAL*8 A, B, C
REAL*16 X
INTEGER*8 COUNTER, I
C_0 = 0.98697635038435719239551219363426327409509390153844Q+00
C PI/E
C C_87 = 0.3141592653589793238462643383279502797D+01 / 0.27182818284&
C &59045235360287471352662314D+01
C_87 = ( 0.31415926535897932384626433832795027974790680981373Q+01 &
&/ 0.27182818284590452353602874713526623143584218671935Q+01 )
C PI
C_8 = 0.31415926535897932384626433832795027974790680981373Q+01
OPEN(UNIT=11, FILE='C:/FORTRAN/ALFA & THETA GENERAL QUAD PRECISION&
&ONE HALF.TXT')
C COUNTER = 0
C I = 1
DO 100 I = -240, 40
X = QEXT(I) / 2.0Q+00
C COUNTER = COUNTER + 1
C PART A OF EXPM = (A/B)^C
A = ((C_0) ** (((X - 8.00Q+00) / 8.00Q+00)) )
C PART B OF EXPM = (A/B)^C
C PART B_1 IS EQUAL TO THE CONSTANT C WITH INDEX I
B_1 = (( C_0 ) * (( C_87 )** (X)))
B_2 = (( X - 8.00Q+00 ) / ( X** 2.00Q+00 - 16.00Q+00 * X + 80.00Q&
&+00 ) )
B_3 = (( 11.00Q+00 * X - 88.00Q+00 ) / 24.00Q+00 )
C FINAL RESULT FOR B
B = (( (B_1) * (B_2) ) ** QCMPLX (B_3) )
C c PART OF THE EQUATION (A/B) **C
C_1 = (( C_0 ) * ((C_87 ) ** QCMPLX ( X )))
C_2 = QCMPLX (( ( X ) - 8.00Q+00) / 24.00Q+00 )
C = QCMPLX (( ( C_1)) * ( ( C_2)))
C EXPM = (A/B)**C
EXPM = QCMPLX ((QCMPLX (A) / QCMPLX (B)) ** QCMPLX (C))
COMPUTE ALFA_MINUS_HALF_1 PART = RECIPROCAL OF ALPHA ^ 1/2
ALFA_MINUS_HALF_1 = QCMPLX ((C_0) * ((C_87) ** (QCMPLX (X + (EXPM)&
& ) ) ))
COMPUTE ALFA_MINUS_HALF_2 PART = RECIPROCAL OF ALPHA ^ 1/2
ALFA_MINUS_HALF_2 = (( X - 8.00Q+00 ) / (( X*X ) - 16.00Q+00 *X +8&
&0.00Q+00) )
C COMPUTE ALFA_MINUS_HALF_3 PART OF RECIPROCAL OF ALPHA ^ (-1/2)
ALFA_MINUS_HALF_3 = ( ((9.00Q+00 * X ) - 8.00Q+00 ) / ( 8.00Q+00 &
&* EXPM ) )
C COMPUTE FINAL ALFA MINUS HALF = (PART18PART2)**PART3
ALFA_MINUS_HALF = ((( ( ALFA_MINUS_HALF_1 )) * (( ALFA_MINUS_HALF&
&_2 )) ) ** ( QCMPLX ( ALFA_MINUS_HALF_3 )) )
C ALFA_MINUS_HALF SQUARED = RECIPROCAL OF ALFA
ALFA_SQUARE = ( ( ALFA_MINUS_HALF ) ** 2.00Q+00 )
C FINAL ALFA = 1 / ALFA_SQUARE
ALFA_FINAL = ( 1.00Q+00 / ( ALFA_SQUARE ) )
C REAL PART OF ALFA
REAL_PART = QREAL (ALFA_FINAL)
C IMAGINARY PART OF ALFA
IMAG_PART = QIMAG (ALFA_FINAL)
C ABSOLUTE VALUE OF ALFA (MODULUS)
ABSOL_VALUE = ABS (ALFA_FINAL)
C ARCTAN OF THE POLAR FORM = THETA = Y/X
THETA = ATAN2 ( QIMAG (ALFA_FINAL) , QREAL (ALFA_FINAL ))
C ANGLE THETA IN DEGREES
THETA_DEG = ( THETA * 180.00Q+00 ) / C_8
WRITE(11,*)'LOOP VARIABLE X = X-AXIS CONSTANT....................'
WRITE(11,*) X
WRITE(11,*)'_____________________________________________________'
WRITE(11,*)'PART A...............................................'
WRITE(11, *) X, QCMPLX (A)
WRITE(11,*)'_____________________________________________________'
C WRITE(11,*) I, X
C WRITE (11,*) C_87
C WRITE (11,200) I, A
WRITE(11,*)'PART B...............................................'
WRITE (11,*) X, (B_1)
WRITE (11,*) X, (B_2)
WRITE (11,*) X, (B_3)
WRITE (11,*) X, QCMPLX (B)
WRITE(11,*)'_____________________________________________________'
WRITE(11,*)'PART C...............................................'
WRITE (11, *) X, QCMPLX (C_1)
WRITE (11, *) X, QCMPLX (C_2)
WRITE (11, *) X, QCMPLX (C)
WRITE(11,*)'_____________________________________________________'
WRITE(11,*)'EXPONENT MAIN = (A/B)**C.............................'
WRITE(11,*) X, QCMPLX (EXPM)
WRITE(11,*)'_____________________________________________________'
WRITE(11,*)'ALFA ^ ( -1/2 ) PART.................................'
WRITE(11,*) X, QCMPLX (ALFA_MINUS_HALF_1)
WRITE(11,*) X, QCMPLX (ALFA_MINUS_HALF_2)
WRITE(11,*) X, QCMPLX (ALFA_MINUS_HALF_3)
WRITE(11,*) X, QCMPLX (ALFA_MINUS_HALF)
WRITE (11,*)'ALFA SQUARE_________________________________________'
WRITE(11,*) X, (ALFA_SQUARE)
WRITE(11,*)'_____________________________________________________'
WRITE(11,*)'ALPHA FINAL = RECIPROCAL OF ALFA MINUS 1_____________'
WRITE(11,*) X, ( ALFA_FINAL )
WRITE(11,*)'_____________________________________________________'
WRITE(11,*)'REAL PART OF ALPHA...................................'
WRITE(11,*) X, REAL_PART
WRITE(11,*)'IMAGINARY PART OF ALPHA..............................'
WRITE(11,*) X, IMAG_PART
WRITE(11,*)'_____________________________________________________'
WRITE(11,*)'ABSOLUTE VALUE = MODULUS OF ALFA.....................'
WRITE(11,*) X, ABSOL_VALUE
WRITE(11,*)'ANGLE THETA OF POLAR FORM............................'
WRITE(11,*) (THETA)
WRITE(11,*)'ANGLE THETA IN DEGREES...............................'
WRITE(11,*) THETA_DEG
WRITE(11,*)'_____________________________________________________'
100 CONTINUE
CLOSE(11)
STOP
200 FORMAT (I5, (F40.25, E40.25))
300 FORMAT (I5, E40.25)
END PROGRAM ALFA_GENERAL
Comments powered by CComment