V3FIT
fax.f
1  SUBROUTINE fax(ifax, n, mode)
2 C-----------------------------------------------
3 C M o d u l e s
4 C-----------------------------------------------
5  IMPLICIT NONE
6 C-----------------------------------------------
7 C D u m m y A r g u m e n t s
8 C-----------------------------------------------
9  INTEGER n, mode
10  INTEGER, DIMENSION(13) :: ifax
11 C-----------------------------------------------
12 C L o c a l V a r i a b l e s
13 C-----------------------------------------------
14  INTEGER :: nn, k, l, inc, nfax, ii, istop, i, item
15 C-----------------------------------------------
16  nn=n
17  IF (iabs(mode).eq.1) GOTO 10
18  IF (iabs(mode).eq.8) GOTO 10
19  nn=n/2
20  IF ((nn+nn).eq.n) GOTO 10
21  ifax(1)=-99
22  RETURN
23  10 k=1
24 c test for factors of 4
25  20 IF (mod(nn,4).ne.0) GOTO 30
26  k=k+1
27  ifax(k)=4
28  nn=nn/4
29  IF (nn.eq.1) GOTO 80
30  GOTO 20
31 c test for extra factor of 2
32  30 IF (mod(nn,2).ne.0) GOTO 40
33  k=k+1
34  ifax(k)=2
35  nn=nn/2
36  IF (nn.eq.1) GOTO 80
37 c test for factors of 3
38  40 IF (mod(nn,3).ne.0) GOTO 50
39  k=k+1
40  ifax(k)=3
41  nn=nn/3
42  IF (nn.eq.1) GOTO 80
43  GOTO 40
44 c now find remaining factors
45  50 l=5
46  inc=2
47 c inc alternately takes on values 2 and 4
48  60 IF (mod(nn,l).ne.0) GOTO 70
49  k=k+1
50  ifax(k)=l
51  nn=nn/l
52  IF (nn.eq.1) GOTO 80
53  GOTO 60
54  70 l=l+inc
55  inc=6-inc
56  GOTO 60
57  80 ifax(1)=k-1
58 c ifax(1) CONTAINS number of factors
59  nfax=ifax(1)
60 c sort factors into ascending order
61  IF (nfax.eq.1) GOTO 110
62  DO 100 ii=2,nfax
63  istop=nfax+2-ii
64  DO 90 i=2,istop
65  IF (ifax(i+1).ge.ifax(i)) GOTO 90
66  item=ifax(i)
67  ifax(i)=ifax(i+1)
68  ifax(i+1)=item
69  90 CONTINUE
70  100 CONTINUE
71  110 CONTINUE
72 
73  END SUBROUTINE fax