V3FIT
fact.f90
1  SUBROUTINE fact_g(n, ifax)
2  USE stel_kinds
3  IMPLICIT NONE
4 !-----------------------------------------------
5 ! D u m m y A r g u m e n t s
6 !-----------------------------------------------
7  INTEGER n
8  INTEGER, DIMENSION(13) :: ifax
9 #if !defined(CRAY) || defined(LONESTAR) || defined(MCURIE)
10 !-----------------------------------------------
11 ! L o c a l V a r i a b l e s
12 !-----------------------------------------------
13  INTEGER :: nn, k, l, MAX, inc
14 !-----------------------------------------------
15 ! factorization routine that first extracts ALL factors of 4
16  IF (n.gt.1) GOTO 10
17  ifax(1) = 0
18  IF (n.lt.1) ifax(1) = -99
19  RETURN
20  10 nn=n
21  k=1
22 ! test for factors of 4
23  20 IF (mod(nn,4).ne.0) GOTO 30
24  k=k+1
25  ifax(k)=4
26  nn=nn/4
27  IF (nn.eq.1) GOTO 80
28  GOTO 20
29 ! test for extra factor of 2
30  30 IF (mod(nn,2).ne.0) GOTO 40
31  k=k+1
32  ifax(k)=2
33  nn=nn/2
34  IF (nn.eq.1) GOTO 80
35 ! test for factors of 3
36  40 IF (mod(nn,3).ne.0) GOTO 50
37  k=k+1
38  ifax(k)=3
39  nn=nn/3
40  IF (nn.eq.1) GOTO 80
41  GOTO 40
42 ! now find remaining factors
43  50 l=5
44  max = sqrt(real(nn,rprec))
45  inc=2
46 ! inc alternately takes on values 2 and 4
47  60 IF (mod(nn,l).ne.0) GOTO 70
48  k=k+1
49  ifax(k)=l
50  nn=nn/l
51  IF (nn.eq.1) GOTO 80
52  GOTO 60
53  70 IF (l.gt.max) GOTO 75
54  l=l+inc
55  inc=6-inc
56  GOTO 60
57  75 k = k+1
58  ifax(k) = nn
59  80 ifax(1)=k-1
60 ! ifax(1) now CONTAINS number of factors
61 #else
62  CALL fact (n, ifax)
63 #endif
64  END SUBROUTINE fact_g