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 JSPPOLE(PSHUP,KNUMB,KTRUNC,OMARS,PXF) 12 IMPLICIT NONE 13C 14C----> 15C**** *JSPPOLE* - Calculates fourier coefficient for U or V at pole 16C 17C Purpose 18C ------- 19C 20C Calculates fourier coefficient for first harmonic only 21C for U and V wind component at the pole. 22C 23C Interface 24C --------- 25C 26C CALL JSPPOLE(PSHUP,KNUMB,KTRUNC,OMARS,PXF) 27C 28C Input parameters 29C ---------------- 30C 31C PSHUP - Unpacked harmonics field, unpacked 32C KNUMB - 1 for North Pole, otherwise South Pole 33C KTRUNC - Number (value) of the trucation 34C OMARS - .TRUE. if data is from MARS 35C PXF - Fourier coefficients (zero on input) 36C 37C 38C Output parameters 39C ----------------- 40C 41C PXF(2) - Single fourier coefficient calculated 42C 43C 44C Common block usage 45C ----------------- 46C 47C None. 48C 49C 50C Externals 51C --------- 52C 53C None. 54C 55C 56C Author 57C ------ 58C 59C J.D.Chambers *ECMWF* Oct 1993 60C 61C 62C Modifications 63C ------------- 64C 65C None. 66C 67C 68C Comments 69C -------- 70C 71C Created from SPPOLE. 72C Changed to provide all parameters in the call, i.e. no common 73C blocks are used. 74C 75C 76C Method 77C ------ 78C 79C None. 80C 81C 82C Reference 83C _________ 84C 85C None. 86C 87C----< 88C _______________________________________________________ 89C 90C* Section 0. Definition of variables. 91C _______________________________________________________ 92C 93C* Prefix conventions for variable names 94C 95C Logical L (but not LP), global or common. 96C O, dummy argument 97C G, local variable 98C LP, parameter. 99C Character C, global or common. 100C H, dummy argument 101C Y (but not YP), local variable 102C YP, parameter. 103C Integer M and N, global or common. 104C K, dummy argument 105C I, local variable 106C J (but not JP), loop control 107C JP, parameter. 108C REAL A to F and Q to X, global or common. 109C P (but not PP), dummy argument 110C Z, local variable 111C PP, parameter. 112C 113C Dummy arguments 114C 115 COMPLEX PSHUP 116 INTEGER KNUMB 117 INTEGER KTRUNC 118 LOGICAL OMARS 119 COMPLEX PXF 120 DIMENSION PSHUP(*) 121 DIMENSION PXF(*) 122C 123C Local variables 124C 125 INTEGER I1, ITIN1, ITOUT1, JN 126 REAL Z1, Z2, ZNORM, ZP1, ZP2, ZPOL 127C 128C ----------------------------------------------------------- 129C 130C* 1. Set initial values 131C ------------------ 132C 133 100 CONTINUE 134C 135 ITIN1 = KTRUNC + 1 136 ITOUT1 = KTRUNC 137C 138 ZPOL = 1. 139 IF (KNUMB .NE. 1) ZPOL = -1.0 140C 141 ZP1 = -1.0 142 ZP2 = -3.0 * ZPOL 143 I1 = ITIN1 + 1 144C 145C* 2. Change normalisation (if flagged as necessary) 146C -------------------- 147C 148 200 CONTINUE 149C 150 IF (OMARS) THEN 151 ZNORM = -SQRT(2.0) 152 ELSE 153 ZNORM = 1 154 ENDIF 155C 156C 157C* 3. Calculation 158C ----------- 159C 160 300 CONTINUE 161 PXF(2) = (0.0,0.0) 162C 163C Calculate the fourier coefficient for the first harmonic only. 164 DO 310 JN = 1,ITOUT1,2 165C 166 Z1 = SQRT( (2.0*JN + 1.0)/(2.0*JN*(JN + 1.0)) ) 167 Z2 = SQRT( (2.0*(JN + 1.0) +1.0)/(2.0*(JN +1.0)*(JN +2.0)) ) 168C 169 IF (JN .EQ. ITOUT1) Z2 = 0.0 170C 171 PXF(2) = PXF(2) +(Z1*ZP1*PSHUP(I1) +Z2*ZP2*PSHUP(I1+1))*ZNORM 172 ZP1 = ZP1 - 2.0*(JN + 1.0) - 1.0 173 ZP2 = ZP2 - (2.0*(JN + 2.0) + 1.0)*ZPOL 174 I1 = I1 + 2 175C 176 310 CONTINUE 177C 178C ------------------------------------------------------------- 179C 180 RETURN 181C 182 END 183