| 1 |
|
subroutine WIGNER3JM (L1, L2, L3, M1, M2MIN, M2MAX, THRCOF, NDIM, & |
| 2 |
|
IER) |
| 3 |
< |
use status |
| 3 |
> |
! use status |
| 4 |
|
! |
| 5 |
|
!! DRC3JM evaluates the 3j symbol g(M2) for all allowed values of M2. |
| 6 |
|
! |
| 158 |
|
if ( (L1-ABS(M1)+EPS < ZERO).OR. & |
| 159 |
|
(MOD(L1+ABS(M1)+EPS,ONE) >= EPS+EPS))THEN |
| 160 |
|
IER=1 |
| 161 |
< |
call handleError('Wigner3jm','L1-ABS(M1) less than zero or '// & |
| 162 |
< |
'L1+ABS(M1) not integer.') |
| 161 |
> |
! call handleError('Wigner3jm','L1-ABS(M1) less than zero or '// & |
| 162 |
> |
! 'L1+ABS(M1) not integer.') |
| 163 |
|
return |
| 164 |
|
ELSEIF((L1+L2-L3 < -EPS).OR.(L1-L2+L3 < -EPS).OR. & |
| 165 |
|
(-L1+L2+L3 < -EPS))THEN |
| 166 |
|
IER=2 |
| 167 |
< |
call handleError('Wigner3jm','L1, L2, L3 do not satisfy '// & |
| 168 |
< |
'triangular condition.') |
| 167 |
> |
write(*,*) eps |
| 168 |
> |
write(*,*) L1,L2,L3 |
| 169 |
> |
write(*,*) "L1,L2,L3 do not satisfy triangular condition" |
| 170 |
> |
! call handleError('Wigner3jm','L1, L2, L3 do not satisfy '// & |
| 171 |
> |
! 'triangular condition.') |
| 172 |
|
return |
| 173 |
|
ELSEIF(MOD(L1+L2+L3+EPS,ONE) >= EPS+EPS)THEN |
| 174 |
|
IER=3 |
| 175 |
< |
call handleError('Wigner3jm','L1+L2+L3 not integer.') |
| 175 |
> |
! call handleError('Wigner3jm','L1+L2+L3 not integer.') |
| 176 |
|
return |
| 177 |
|
end if |
| 178 |
|
! |
| 184 |
|
! Check error condition 4. |
| 185 |
|
if ( MOD(M2MAX-M2MIN+EPS,ONE) >= EPS+EPS)THEN |
| 186 |
|
IER=4 |
| 187 |
< |
call handleError('Wigner3jm','M2MAX-M2MIN not integer.') |
| 187 |
> |
! call handleError('Wigner3jm','M2MAX-M2MIN not integer.') |
| 188 |
|
return |
| 189 |
|
end if |
| 190 |
|
if ( M2MIN < M2MAX-EPS) go to 20 |
| 192 |
|
! |
| 193 |
|
! Check error condition 5. |
| 194 |
|
IER=5 |
| 195 |
< |
call handleError('Wigner3jm','M2MIN greater than M2MAX.') |
| 195 |
> |
! call handleError('Wigner3jm','M2MIN greater than M2MAX.') |
| 196 |
|
return |
| 197 |
|
! |
| 198 |
|
! |
| 211 |
|
! |
| 212 |
|
! Check error condition 6. |
| 213 |
|
21 IER = 6 |
| 214 |
< |
call handleError('Wigner3jm','Dimension of result array for '// & |
| 215 |
< |
'3j coefficients too small.') |
| 214 |
> |
! call handleError('Wigner3jm','Dimension of result array for '// & |
| 215 |
> |
! '3j coefficients too small.') |
| 216 |
|
return |
| 217 |
|
! |
| 218 |
|
! |
| 427 |
|
! |
| 428 |
|
return |
| 429 |
|
end |
| 430 |
+ |
|
| 431 |
+ |
|
| 432 |
+ |
!DECK D1MACH |
| 433 |
+ |
DOUBLE PRECISION FUNCTION D1MACH (I) |
| 434 |
+ |
IMPLICIT NONE |
| 435 |
+ |
INTEGER :: I |
| 436 |
+ |
DOUBLE PRECISION :: B, X |
| 437 |
+ |
!***BEGIN PROLOGUE D1MACH |
| 438 |
+ |
!***PURPOSE Return floating point machine dependent constants. |
| 439 |
+ |
!***LIBRARY SLATEC |
| 440 |
+ |
!***CATEGORY R1 |
| 441 |
+ |
!***TYPE SINGLE PRECISION (D1MACH-S, D1MACH-D) |
| 442 |
+ |
!***KEYWORDS MACHINE CONSTANTS |
| 443 |
+ |
!***AUTHOR Fox, P. A., (Bell Labs) |
| 444 |
+ |
! Hall, A. D., (Bell Labs) |
| 445 |
+ |
! Schryer, N. L., (Bell Labs) |
| 446 |
+ |
!***DESCRIPTION |
| 447 |
+ |
! |
| 448 |
+ |
! D1MACH can be used to obtain machine-dependent parameters for the |
| 449 |
+ |
! local machine environment. It is a function subprogram with one |
| 450 |
+ |
! (input) argument, and can be referenced as follows: |
| 451 |
+ |
! |
| 452 |
+ |
! A = D1MACH(I) |
| 453 |
+ |
! |
| 454 |
+ |
! where I=1,...,5. The (output) value of A above is determined by |
| 455 |
+ |
! the (input) value of I. The results for various values of I are |
| 456 |
+ |
! discussed below. |
| 457 |
+ |
! |
| 458 |
+ |
! D1MACH(1) = B**(EMIN-1), the smallest positive magnitude. |
| 459 |
+ |
! D1MACH(2) = B**EMAX*(1 - B**(-T)), the largest magnitude. |
| 460 |
+ |
! D1MACH(3) = B**(-T), the smallest relative spacing. |
| 461 |
+ |
! D1MACH(4) = B**(1-T), the largest relative spacing. |
| 462 |
+ |
! D1MACH(5) = LOG10(B) |
| 463 |
+ |
! |
| 464 |
+ |
! Assume single precision numbers are represented in the T-digit, |
| 465 |
+ |
! base-B form |
| 466 |
+ |
! |
| 467 |
+ |
! sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) ) |
| 468 |
+ |
! |
| 469 |
+ |
! where 0 .LE. X(I) .LT. B for I=1,...,T, 0 .LT. X(1), and |
| 470 |
+ |
! EMIN .LE. E .LE. EMAX. |
| 471 |
+ |
! |
| 472 |
+ |
! The values of B, T, EMIN and EMAX are provided in I1MACH as |
| 473 |
+ |
! follows: |
| 474 |
+ |
! I1MACH(10) = B, the base. |
| 475 |
+ |
! I1MACH(11) = T, the number of base-B digits. |
| 476 |
+ |
! I1MACH(12) = EMIN, the smallest exponent E. |
| 477 |
+ |
! I1MACH(13) = EMAX, the largest exponent E. |
| 478 |
+ |
! |
| 479 |
+ |
! |
| 480 |
+ |
!***REFERENCES P. A. Fox, A. D. Hall and N. L. Schryer, Framework for |
| 481 |
+ |
! a portable library, ACM Transactions on Mathematical |
| 482 |
+ |
! Software 4, 2 (June 1978), pp. 177-188. |
| 483 |
+ |
!***ROUTINES CALLED XERMSG |
| 484 |
+ |
!***REVISION HISTORY (YYMMDD) |
| 485 |
+ |
! 790101 DATE WRITTEN |
| 486 |
+ |
! 960329 Modified for Fortran 90 (BE after suggestions by EHG) |
| 487 |
+ |
!***END PROLOGUE D1MACH |
| 488 |
+ |
! |
| 489 |
+ |
X = 1.0D0 |
| 490 |
+ |
B = RADIX(X) |
| 491 |
+ |
SELECT CASE (I) |
| 492 |
+ |
CASE (1) |
| 493 |
+ |
D1MACH = B**(MINEXPONENT(X)-1) ! the smallest positive magnitude. |
| 494 |
+ |
CASE (2) |
| 495 |
+ |
D1MACH = HUGE(X) ! the largest magnitude. |
| 496 |
+ |
CASE (3) |
| 497 |
+ |
D1MACH = B**(-DIGITS(X)) ! the smallest relative spacing. |
| 498 |
+ |
CASE (4) |
| 499 |
+ |
D1MACH = B**(1-DIGITS(X)) ! the largest relative spacing. |
| 500 |
+ |
CASE (5) |
| 501 |
+ |
D1MACH = LOG10(B) |
| 502 |
+ |
CASE DEFAULT |
| 503 |
+ |
WRITE (*, FMT = 9000) |
| 504 |
+ |
9000 FORMAT ('1ERROR 1 IN D1MACH - I OUT OF BOUNDS') |
| 505 |
+ |
STOP |
| 506 |
+ |
END SELECT |
| 507 |
+ |
RETURN |
| 508 |
+ |
END |
