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 IGINT (KWEDIST, KOWE, KNSDIST, KONS, PWFACT, 12 1 KPR, KERR) 13C 14C----> 15C**** *IGINT* 16C 17C PURPOSE 18C _______ 19C 20C Calculate the basic unnormalised interpolation weights when 21C interpolating between regular grids. 22C 23C INTERFACE 24C _________ 25C 26C IERR = IGINT (KWEDIST, KOWE, KNSDIST, KONS, PWFACT, KPR, KERR) 27C 28C Input parameters 29C ________________ 30C 31C KWEDIST - This array holds the distances to longitude values 32C in the input field from the associated longitude 33C values in the output field. This distance is the 34C same for every line of latitude for a regular 35C input field. 36C 37C KOWE - The number of points in the West-East direction in 38C the output field. 39C 40C KNSDIST - This array holds the distances to lines in input 41C field from the associated lines of latitude in the 42C output field. The array is dimensioned (2, KONS). 43C 44C KONS - The number of points in the North-South direction 45C in the output field. 46C 47C KPR - The debug print switch. 48C 0 , No debugging output. 49C 1 , Produce debugging output. 50C 51C KERR - The error control flag. 52C -ve, No error message. Return error code. 53C 0 , Hard failure with error message. 54C +ve, Print error message. Return error code. 55C 56C Output parameters 57C ________________ 58C 59C PWFACT - The unnormalised array of interpolating weights to 60C the four neighbouring points for every output point. 61C 62C Return value 63C ____________ 64C 65C The error indicator (INTEGER). 66C 67C Error and Warning Return Values 68C _______________________________ 69C 70C None 71C 72C Common block usage 73C __________________ 74C 75C None 76C 77C EXTERNALS 78C _________ 79C 80C IGINTR - Calculate the basic unnormalised interpolation 81C weights for one line of latitude when 82C interpolating between regular grids. 83C INTLOG - Logs messages. 84C 85C METHOD 86C ______ 87C 88C The weights are evaluated as the size of the opposing rectangle. 89C It is trivial to show that this is equivalent to weighting by 90C the inverse size of the rectangle of which the input point forms 91C part. 92C 93C REFERENCE 94C _________ 95C 96C None 97C 98C COMMENTS 99C ________ 100C 101C Program contains sections 0 to 2 and 9 102C 103C AUTHOR 104C ______ 105C 106C K. Fielding *ECMWF* Oct 1993 107C 108C MODIFICATIONS 109C _____________ 110C 111C None 112C 113C----< 114C _______________________________________________________ 115C 116C 117C* Section 0. Definition of variables. 118C _______________________________________________________ 119C 120C* Prefix conventions for variable names 121C 122C Logical L (but not LP), global or common. 123C O, dummy argument 124C G, local variable 125C LP, parameter. 126C Character C, global or common. 127C H, dummy argument 128C Y (but not YP), local variable 129C YP, parameter. 130C Integer M and N, global or common. 131C K, dummy argument 132C I, local variable 133C J (but not JP), loop control 134C JP, parameter. 135C REAL A to F and Q to X, global or common. 136C P (but not PP), dummy argument 137C Z, local variable 138C PP, parameter. 139C 140C Implicit statement to force declarations 141C 142 IMPLICIT NONE 143C 144#include "parim.h" 145C 146C Dummy arguments 147 INTEGER KOWE, KONS, KPR, KERR 148 INTEGER KWEDIST (2, KOWE), KNSDIST (2, KONS) 149 REAL PWFACT (4, KOWE, KONS) 150C 151C Local variables 152 INTEGER IPR, IERR 153 INTEGER JOLAT 154 INTEGER JPROUTINE 155 PARAMETER (JPROUTINE = 22200) 156C 157C External functions 158 INTEGER IGINTR 159C 160C _______________________________________________________ 161C 162C 163C* Section 1. Initialisation 164C _______________________________________________________ 165C 166 100 CONTINUE 167C 168 IF (KPR.GE.1) CALL INTLOG(JP_DEBUG,'IGINT: Section 1.',JPQUIET) 169C 170 IGINT = 0 171C 172 IF (KPR .GE. 1) THEN 173 CALL INTLOG(JP_DEBUG,'IGINT: Input parameters.',JPQUIET) 174 CALL INTLOG(JP_DEBUG,'IGINT: No.output longitudes = ',KOWE) 175 CALL INTLOG(JP_DEBUG,'IGINT: No.output latitudes = ',KONS) 176 ENDIF 177C 178C _______________________________________________________ 179C 180C 181C* Section 2. Calculate arrays of weights 182C _______________________________________________________ 183C 184 200 CONTINUE 185C 186 IF (KPR.GE.1) CALL INTLOG(JP_DEBUG,'IGINT: Section 2.',JPQUIET) 187C 188C Main loop over latitudes 189C 190 IPR = KPR 191C 192 DO 220 JOLAT = 1, KONS 193C 194 IERR = IGINTR (KWEDIST, KOWE, KNSDIST (1, JOLAT), 195 1 PWFACT (1, 1, JOLAT), IPR, KERR) 196C 197 IF (IERR .GT. 0) THEN 198 IGINT = IERR 199 GO TO 900 200 ENDIF 201C 202 IPR = KPR - 1 203C 204 220 CONTINUE 205C 206C _______________________________________________________ 207C 208C 209C* Section 9. Return to calling routine. Format statements 210C _______________________________________________________ 211C 212 900 CONTINUE 213C 214 IF (KPR.GE.1) CALL INTLOG(JP_DEBUG,'IGINT: Section 9.',JPQUIET) 215C 216 RETURN 217 END 218