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 JUVPOLE(PSHUP, KTRUNC, PZFA, KLONO, KRET) 12C 13C----> 14C**** JUVPOLE 15C 16C Purpose 17C ------- 18C This routine creates polar wind U or V components for lat/long 19C grid fields. 20C 21C 22C Interface 23C --------- 24C CALL JUVPOLE(PSHUP, KTRUNC, PZFA, KLONO, KRET) 25C 26C 27C Input parameters 28C ---------------- 29C PSHUP - Spherical harmonics field, unpacked 30C KTRUNC - Truncation number of spherical harmonics field 31C KLONO - Number of longitude points in output field 32C 33C 34C Output parameters 35C ----------------- 36C PZFA - Output grid point field; contains upto 32 each of 37C North and South latitude rows symmetrically. 38C KRET - Return status code 39C 0 = OK 40C 41C 42C Common block usage 43C ------------------ 44C JDCNDBG 45C 46C 47C Method 48C ------ 49C For each pole, creates the reduced gaussian grid lines nearest to 50C the pole and does a linear interpolation to the polar longitude. 51C 52C 53C Externals 54C --------- 55C JAGGGP - converts spectral input to a gaussian grid 56C INTLOG - Output log message 57C 58C 59C Reference 60C --------- 61C None. 62C 63C Comments 64C -------- 65C None. 66C 67C 68C Author 69C ------ 70C J.D.Chambers ECMWF October 2002 71C 72C 73C Modifications 74C ------------- 75C None. 76C 77C 78C----< 79C -----------------------------------------------------------------| 80C 81 IMPLICIT NONE 82C 83#include "jparams.h" 84#include "parim.h" 85#include "current.h" 86#include "nofld.common" 87#include "grfixed.h" 88C 89C Subroutine arguments 90C 91 COMPLEX PSHUP(*) 92 REAL PZFA(JPLONO + 2, 64) 93 INTEGER KTRUNC, KLONO, KRET 94C 95C Parameters 96C 97C Local variables 98C 99 REAL EAST, WEST, LAT, POUTF(18), ALATS(320) 100 REAL XLONG, WLEFT, XSTEP, GSTEP 101 INTEGER KPTS(320), NUM, LOOP, NLEFT, NRIGHT, LUV 102 CHARACTER*1 HTYPE 103C 104C Externals 105C 106 INTEGER IGGLAT 107 EXTERNAL IGGLAT 108C 109C -----------------------------------------------------------------| 110C* Section 1. Initialization. 111C -----------------------------------------------------------------| 112C 113 100 CONTINUE 114C 115 KRET = 0 116C 117 NUM = 160 118 GSTEP = 360.0 / 18.0 119 XSTEP = 360.0 / REAL(KLONO) 120 EAST = 360.0 - GSTEP 121 WEST = 0.0 122C 123C -----------------------------------------------------------------| 124C* Section 2. Create North pole values 125C -----------------------------------------------------------------| 126C 127 200 CONTINUE 128C 129C Form the N160 reduced gaussian grid latitude near the North pole 130C 131 LAT = 90.0 132 HTYPE = 'R' 133 LUV = 1 134 CALL JAGGGP(PSHUP, KTRUNC, LAT, LAT, WEST, EAST, 135 X NUM, HTYPE, KPTS, POUTF, LUV, KRET) 136 IF( KRET.NE.0 ) THEN 137 CALL INTLOG(JP_ERROR, 138 X 'JUVPOLE: problem forming Northern gaussian grid latitude', 139 X JPQUIET) 140 GOTO 900 141 ENDIF 142C 143C Interpolate to the lat/long northern latitude grid points 144C 145 DO LOOP = 1, KLONO 146C 147C Find the gaussian neighbours on either side of lat/long point 148C and their weights 149C 150 XLONG = XSTEP * REAL(LOOP-1) 151C 152 NLEFT = 1 + INT(XLONG/GSTEP) 153 NRIGHT = NLEFT + 1 154 IF( NRIGHT.GT.18 ) NRIGHT = 1 155C 156 WLEFT = 1.0 - (ABS((XLONG - (NLEFT-1)*GSTEP))/GSTEP) 157C 158 PZFA(LOOP,1) = POUTF(NLEFT)*WLEFT + POUTF(NRIGHT)*(1.0-WLEFT) 159 ENDDO 160C 161C -----------------------------------------------------------------| 162C* Section 3. Create South pole values 163C -----------------------------------------------------------------| 164C 165 300 CONTINUE 166C 167C Store latitude and point count values for the next call to JAGGGP 168C which uses the 'U' option (user supplied values). 169C 170 NOGAUSO = NUM 171C 172 KRET = IGGLAT(NUM*2, ALATS, 1, 1) 173 IF( KRET.NE.0 ) THEN 174 CALL INTLOG(JP_ERROR, 'JUVPOLE: IGGLAT call failed',KRET) 175 KRET = KRET 176 GOTO 900 177 ENDIF 178C 179 DO LOOP = 1, NUM*2 180 NOLPTS(LOOP) = KPTS(LOOP) 181 ROGAUSS(LOOP) = ALATS(LOOP) 182 ENDDO 183C 184C Form the N160 reduced gaussian grid latitude near the South pole 185C 186 LAT = -90.0 187 HTYPE = 'U' 188 LUV = 1 189 CALL JAGGGP(PSHUP, KTRUNC, LAT, LAT, WEST, EAST, 190 X NUM, HTYPE, KPTS, POUTF, LUV, KRET) 191 IF( KRET.NE.0 ) THEN 192 CALL INTLOG(JP_ERROR, 193 X 'JUVPOLE: problem forming Southern gaussian grid latitude', 194 X JPQUIET) 195 GOTO 900 196 ENDIF 197C 198C Interpolate to the lat/long southern latitude grid points 199C 200 DO LOOP = 1, KLONO 201C 202C Find the gaussian neighbours on either side of lat/long point 203C and their weights 204C 205 XLONG = XSTEP * REAL(LOOP-1) 206C 207 NLEFT = 1 + INT(XLONG/GSTEP) 208 NRIGHT = NLEFT + 1 209 IF( NRIGHT.GT.18 ) NRIGHT = 1 210C 211 WLEFT = 1.0 - (ABS((XLONG - (NLEFT-1)*GSTEP))/GSTEP) 212C 213 PZFA(LOOP,2) = POUTF(NLEFT)*WLEFT + POUTF(NRIGHT)*(1.0-WLEFT) 214 ENDDO 215C 216C -----------------------------------------------------------------| 217C* Section 9. Return. 218C -----------------------------------------------------------------| 219C 220 900 CONTINUE 221C 222 RETURN 223 END 224