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