1C Copyright 1981-2016 ECMWF. 2C 3C This software is licensed under the terms of the Apache Licence 4C Version 2.0 which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. 5C 6C In applying this licence, ECMWF does not waive the privileges and immunities 7C granted to it by virtue of its status as an intergovernmental organisation 8C nor does it submit to any jurisdiction. 9C 10 11 SUBROUTINE JJSET99(TRIGS, IFAX, N, KRET) 12C 13C----> 14C**** JJSET99 15C 16C PURPOSE 17C _______ 18C 19C Computes factors of N & sines and cosines required by FFT99 20C and FFT991. 21C 22C INTERFACE 23C _________ 24C 25C CALL JJSET99(TRIGS, IFAX, N, KRET)) 26C 27C Input parameters 28C ________________ 29C 30C N - Number to factorise. 31C 32C Output parameters 33C ________________ 34C 35C TRIGS - Sines and cosines for angles 0 to pi in N steps 36C (sin,cos,sin,cos,...) 37C IFAX - Allowed factors of N from 8,6,5,4,3,2. 38C (Only one 8 allowed). 39C IFAX(1) = count of factors. 40C IFAX(2-9)= factor (or zero). 41C IFAX(10) = N. 42C KRET - 0 if factorised OK. 43C 44C Method 45C ______ 46C 47C Look for sixes first, store factors in order: 8,6,5,4,3,2; 48C then reverses the order for output. 49C 50C 51C Externals 52C _________ 53C 54C INTLOG - Log error messages. 55C 56C 57C Reference 58C _________ 59C 60C None. 61C 62C 63C Comments 64C ________ 65C 66C This is a tidy up, based on set99.F 67C 68C 69C AUTHOR 70C ______ 71C 72C J.D.Chambers *ECMWF* Nov 1996 73C 74C 75C MODIFICATIONS 76C _____________ 77C 78C None. 79C 80C----< 81C _______________________________________________________ 82C 83C* Section 0. Definition of variables. 84C _______________________________________________________ 85C 86C 87 IMPLICIT NONE 88#include "jparams.h" 89#include "parim.h" 90C 91C Parameters 92 INTEGER JPROUTINE 93 PARAMETER ( JPROUTINE = 31500 ) 94C 95C Subroutine arguments 96 REAL TRIGS 97 INTEGER IFAX, N, KRET 98 DIMENSION TRIGS(N), IFAX(10) 99C 100C Local variables 101 INTEGER JFAX, LFAX, LOOP, NIL, NHL, NU, I, K, L, IFAC, NFAX 102 DIMENSION LFAX(7), JFAX(10) 103 DATA LFAX/6,8,5,4,3,2,1/ 104 REAL DEL, ANGLE 105C 106C _______________________________________________________ 107C 108C Section 1. Initialization. 109C _______________________________________________________ 110C 111 100 CONTINUE 112C 113 DO LOOP = 1, 10 114 JFAX(LOOP) = 0 115 ENDDO 116C 117 KRET = 0 118C 119C Generate sines and cosines for angles 0 to pi in N steps 120C 121 DEL = (2.0*PPI) / FLOAT(N) 122 NIL = 0 123 NHL = (N/2)-1 124C 125 DO K = NIL,NHL 126 ANGLE = FLOAT(K)*DEL 127 TRIGS(2*K+1) = COS(ANGLE) 128 TRIGS(2*K+2) = SIN(ANGLE) 129 ENDDO 130C 131C _______________________________________________________ 132C 133C Section 2. Find allowed factors of N 134C (8,6,5,4,3,2; only one 8 allowed) 135C _______________________________________________________ 136C 137 200 CONTINUE 138C 139C Look for sixes first, store factors in order: 8,6,5,4,3,2 140C 141 NU = N 142 IFAC = 6 143 K = 0 144 L = 1 145C 146C Loop through potential factors. 147C 148 220 CONTINUE 149C 150 IF (MOD(NU,IFAC).EQ.0) THEN 151C 152C Allowed factor found 153 K = K+1 154C 155 IF( K.GT.8) THEN 156 CALL INTLOG(JP_ERROR,'Too many factors found factorising ',N) 157 KRET = JPROUTINE + 1 158 GOTO 910 159 ENDIF 160C 161 JFAX(K) = IFAC 162C 163C If factor is 8 .. 164 IF (IFAC.EQ.8) THEN 165C 166C Swap 8 into first array slot instead of 6 if 6 already found 167 IF (K.NE.1) THEN 168 JFAX(1) = 8 169 JFAX(K) = 6 170 ENDIF 171 ENDIF 172C 173C Factor found 174 NU = NU/IFAC 175C 176C Exit if all factors of N have been found 177 IF (NU.EQ.1) GOTO 900 178C 179C Only one 8 allowed as a factor 180 IF (IFAC.NE.8) GOTO 220 181 ENDIF 182C 183C Pick up next allowed factor. 184 L = L+1 185 IFAC = LFAX(L) 186 IF (IFAC.GT.1) GOTO 220 187C 188C Problem! All allowed factors tried but some factors still left. 189C 190 CALL INTLOG(JP_ERROR,'Illegal factors found factorising ',N) 191 KRET = JPROUTINE + 2 192 GOTO 910 193C _______________________________________________________ 194C 195C Section 9. All factors found. 196C _______________________________________________________ 197C 198 900 CONTINUE 199C 200C Store the factors in the reverse order in the output array. 201C 202 NFAX = K 203 IFAX(1) = NFAX 204 DO I = 1,NFAX 205 IFAX(NFAX+2-I) = JFAX(I) 206 ENDDO 207C 208 IFAX(10) = N 209C 210 910 CONTINUE 211C 212 RETURN 213 END 214