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 INTEGER FUNCTION HSH2GG(NS,EW,KTRUNC,KNUM,HTYPE,KPTS,PLATS,KSIZE) 12C 13C----> 14C**** HSH2GG 15C 16C Purpose 17C ------- 18C 19C Finds a suitable Gaussian grid and/or spectral truncation for a 20C given spectral truncation and/or lat/long increments. There are 21C three modes (by order of precedence): 22C - providing NS,EW sets KTRUNC (using AURESOL) and KNUM/HTYPE 23C - providing KTRUNC sets KNUM/HTYPE 24C - providing KNUM sets KTRUNC 25C With KNUM/HTYPE set, the Gaussian grid definition is obtained with 26C JGETGG. 27C Parameters with value zero are assumed not provided. 28C Historically, this merges the functionality of: 29C - HSP2GG 30C - HSP2GG2 31C - HSP2GG3 32C 33C 34C Interface 35C --------- 36C 37C IRET = HSH2GG(NS,EW,KTRUNC,KNUM,HTYPE,KPTS,PLATS,KSIZE) 38C 39C 40C Input parameters 41C ---------------- 42C NS - North-South increment 43C EW - East-West increment 44C 45C 46C Input/output parameters 47C ---------------- 48C KTRUNC - The spectral truncation 49C KNUM - Gaussian grid number 50C HTYPE - Gaussian grid type 51C = 'R' for reduced ("quasi-regular"), 52C = 'O' for reduced/octahedral, 53C = 'F' for full, 54C = 'U' for a user-defined Gaussian grid 55C 56C 57C Output parameters 58C ----------------- 59C KPTS - Array giving number of points along each line of latitude 60C in the reduced Gaussian grid (both hemispheres) 61C PLATS - Array giving Gaussian latitudes (both hemispheres) 62C KSIZE - The number of points in the reduced Gaussian grid 63C 64C Returns 0 if all OK, otherwise there is an error. 65C 66C 67C Externals 68C --------- 69C 70C JGETGG - Reads the definition of a Gaussian grid 71C AURESOL - Returns the default truncation for a given 72C latitude--longitude grid resolution 73C 74C 75C Author 76C ------ 77C 78C J.D.Chambers ECMWF February 2001 79C 80C 81C Modifications 82C ------------- 83C 84C S.Curic ECMWF March 2005 85C Added checking for a automatic trancation T255, T399, T799, T2047 86C and corresponding Gaussian grid. 87C 88C S.Curic ECMWF April 2008 89C Added checking for a automatic trancation T1279 90C and corresponding Gaussian grid. 91C 92C S.Curic ECMWF Semptember 2009 93C Match T255 and T213 against N128 instead of N160 94C upon Alan Geer request 95C 96C 97C----< 98C -----------------------------------------------------------------| 99C* Section 0. Definition of variables 100C -----------------------------------------------------------------| 101 102 IMPLICIT NONE 103#include "parim.h" 104#include "jparams.h" 105 106C Function arguments 107 INTEGER KTRUNC, KNUM, KPTS(*), KSIZE 108 REAL NS, EW, PLATS(*) 109 CHARACTER*1 HTYPE 110 111C Local variables 112 INTEGER I, IRET 113 REAL STEP 114 115C Externals 116 INTEGER AURESOL 117 EXTERNAL AURESOL 118 119C -----------------------------------------------------------------| 120C Section 1. Initialise 121C -----------------------------------------------------------------| 122 123 HSH2GG = 0 124 125C -----------------------------------------------------------------| 126C Section 2. Set adequate truncation/grid number 127C -----------------------------------------------------------------| 128 129 130C if lat/long increments are provided, set automatic KTRUNC truncation 131 IF( (KTRUNC.EQ.0) .AND. (KNUM.EQ.0) ) KTRUNC = AURESOL(NS,EW) 132 133 134C from a given truncation (KTRUNC) find a Gaussian number (KNUM) 135 IF (KTRUNC.NE.0) THEN 136 IF( KTRUNC.NE. 63 .AND. KTRUNC.NE. 64 .AND. 137 . KTRUNC.NE. 95 .AND. KTRUNC.NE. 96 .AND. 138 . KTRUNC.NE. 106 .AND. KTRUNC.NE. 107 .AND. 139 . KTRUNC.NE. 159 .AND. KTRUNC.NE. 160 .AND. 140 . KTRUNC.NE. 191 .AND. KTRUNC.NE. 192 .AND. 141 . KTRUNC.NE. 213 .AND. KTRUNC.NE. 214 .AND. 142 . KTRUNC.NE. 255 .AND. KTRUNC.NE. 256 .AND. 143 . KTRUNC.NE. 319 .AND. KTRUNC.NE. 320 .AND. 144 . KTRUNC.NE. 399 .AND. KTRUNC.NE. 400 .AND. 145 . KTRUNC.NE. 511 .AND. KTRUNC.NE. 512 .AND. 146 . KTRUNC.NE. 639 .AND. KTRUNC.NE. 640 .AND. 147 . KTRUNC.NE. 799 .AND. KTRUNC.NE. 800 .AND. 148 . KTRUNC.NE.1279 .AND. KTRUNC.NE.1280 .AND. 149 . KTRUNC.NE.2047 .AND. KTRUNC.NE.2048 ) THEN 150 CALL INTLOG(JP_ERROR,'HSH2GG: truncation unsupported',KTRUNC) 151 HSH2GG = 2 152 GOTO 900 153 ENDIF 154 STEP = MIN(ABS(NS),ABS(EW)) 155 IF( (KTRUNC.EQ. 63).OR.(KTRUNC.EQ. 64).OR. 156 . (KTRUNC.EQ. 95).OR.(KTRUNC.EQ. 96).OR. 157 . (STEP.GE.2.5) ) THEN ! 2.5 <= step -> T63 158 KNUM = 48 159 ELSEIF( (KTRUNC.EQ. 106).OR.(KTRUNC.EQ. 107).OR. 160 . (KTRUNC.EQ. 159).OR.(KTRUNC.EQ. 160).OR. 161 . (STEP.GE.1.5) ) THEN ! 1.5 <= step < 2.5 -> T106 162 KNUM = 80 163 ELSEIF( (KTRUNC.EQ. 191).OR.(KTRUNC.EQ. 192).OR. 164 . (STEP.GE.0.4 .AND. .FALSE.) ) THEN ! 1.5 <= step < 2.5 -> T191 (commented) 165 KNUM = 96 166 ELSEIF( (KTRUNC.EQ. 213).OR.(KTRUNC.EQ. 214).OR. 167 . (KTRUNC.EQ. 255).OR.(KTRUNC.EQ. 256).OR. ! Enfo 2004 168 . (STEP.GE.0.6) ) THEN ! 0.6 <= step < 1.5 -> T213 169 KNUM = 128 170 ELSEIF( (KTRUNC.EQ. 319).OR.(KTRUNC.EQ. 320).OR. 171 . (STEP.GE.0.4) ) THEN ! 0.4 <= step < 0.6 -> T319 172 KNUM = 160 173 ELSEIF( (KTRUNC.EQ. 399).OR.(KTRUNC.EQ. 400) ) THEN ! Enfo 2005 174 KNUM = 200 175 ELSEIF( (KTRUNC.EQ. 511).OR.(KTRUNC.EQ. 512).OR. ! Oper 2004 176 . (STEP.GE.0.3) ) THEN ! 0.3 <= step < 0.4 -> T511 177 KNUM = 256 178 ELSEIF( (KTRUNC.EQ. 639).OR.(KTRUNC.EQ. 640) ) THEN 179 KNUM = 320 180 ELSEIF( (KTRUNC.EQ. 799).OR.(KTRUNC.EQ. 800).OR. ! Oper 2005 181 . (STEP.GE.0.15) ) THEN ! 0.15 <= step < 0.3 -> T799 182 KNUM = 400 183 ELSEIF( (KTRUNC.EQ.1279).OR.(KTRUNC.EQ.1280).OR. ! Jan Haseler 184 . (STEP.GE.0.09) ) THEN ! 0.09 <= step < 0.15 -> T1279 185 KNUM = 640 186 ELSEIF( (KTRUNC.EQ.2047).OR.(KTRUNC.EQ.2048).OR. ! Mariano 187 . (STEP.LT.0.09) ) THEN ! 0.09 <= step < 0.15 -> T1279 188 KNUM = 1024 189 ENDIF 190 HTYPE = 'R' 191 192 193C from a given Gaussian number (KNUM) find a truncation (KTRUNC) 194 ELSEIF (KNUM.NE.0) THEN 195 IF( KNUM.NE. 48 .AND. KNUM.NE. 80 .AND. KNUM.NE. 96 .AND. 196 . KNUM.NE. 128 .AND. KNUM.NE. 160 .AND. KNUM.NE. 200 .AND. 197 . KNUM.NE. 256 .AND. KNUM.NE. 320 .AND. KNUM.NE. 400 .AND. 198 . KNUM.NE. 640 .AND. KNUM.NE.1024 .AND. KNUM.NE.1280 ) THEN 199 CALL INTLOG(JP_ERROR,'HSH2GG: Gaussian number unsupported',KNUM) 200 HSH2GG = 2 201 GOTO 900 202 ENDIF 203 IF( KNUM.EQ. 48 ) THEN 204C KTRUNC = 63 205 KTRUNC = 95 206 ELSEIF( KNUM.EQ. 80 ) THEN 207 KTRUNC = 159 208 ELSEIF( KNUM.EQ. 96 ) THEN 209 KTRUNC = 191 ! Elias 2014 210 ELSEIF( KNUM.EQ. 128 ) THEN 211C KTRUNC = 213 212 KTRUNC = 255 ! Enfo 2004 213 ELSEIF( KNUM.EQ. 160 ) THEN 214 KTRUNC = 319 215 ELSEIF( KNUM.EQ. 200 ) THEN 216 KTRUNC = 399 ! Enfo 2005 217 ELSEIF( KNUM.EQ. 256 ) THEN 218 KTRUNC = 511 ! Oper 2004 219 ELSEIF( KNUM.EQ. 320 ) THEN 220 KTRUNC = 639 221 ELSEIF( KNUM.EQ. 400 ) THEN 222 KTRUNC = 799 ! Oper 2005 223 ELSEIF( KNUM.EQ. 640 ) THEN 224 KTRUNC = 1279 ! Jan Haseler 225 ELSEIF( KNUM.EQ.1024 ) THEN 226 KTRUNC = 2047 ! Mariano 227 ELSEIF( KNUM.EQ.1280 ) THEN 228 KTRUNC = 1279 ! (cubic octahedral) 229 ENDIF 230 231 ENDIF 232 233C -----------------------------------------------------------------| 234C Section 3. Get the reduced Gaussian grid and count points 235C -----------------------------------------------------------------| 236 237 CALL INTLOG(JP_DEBUG,'HSH2GG: spectral truncation:',KTRUNC) 238 CALL INTLOG(JP_DEBUG,'HSH2GG: Gaussian grid: '//HTYPE,KNUM) 239 IF( HTYPE.NE.'R' .AND. HTYPE.NE.'O' .AND. 240 X HTYPE.NE.'F' .AND. HTYPE.NE.'U' ) THEN 241 CALL INTLOG(JP_ERROR, 242 X 'HSH2GG: Gaussian type unsupported: '//HTYPE,JPQUIET) 243 HSH2GG = 3 244 GOTO 900 245 ENDIF 246 CALL JGETGG(KNUM,HTYPE,PLATS,KPTS,IRET) 247 IF( IRET.NE.0 ) THEN 248 CALL INTLOG(JP_ERROR, 'HSH2GG: JGETGG failed',JPQUIET) 249 HSH2GG = 3 250 ELSE 251 KSIZE = 0 252 DO I = 1, KNUM*2 253 KSIZE = KSIZE + KPTS(I) 254 ENDDO 255 ENDIF 256 257C -----------------------------------------------------------------| 258C Section 9. Return 259C -----------------------------------------------------------------| 260 261 900 CONTINUE 262 RETURN 263 264 END 265