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 INTEGER FUNCTION JBESS (KTRUNC, PBESJ0) 11C 12C**** *JBESS* - Routine to return zeros of the J0 Bessel function. 13C 14C PURPOSE 15C _______ 16C 17C This routine returns up to JPLOOK zeros of the J0 Bessel function. 18C If more than JPLOOK zeros are required then approximate zeros are 19C returned after the JPLOOK-th. 20C 21C INTERFACE 22C _________ 23C 24C IERR = JBESS (KTRUNC, PBESJ0) 25C 26C Input parameters 27C ________________ 28C 29C KTRUNC - This is the number of zeros of the J0 Bessel 30C function required. 31C 32C Output parameters 33C ________________ 34C 35C PBESJ0 - The output array of zeros of the J0 Bessel function. 36C 37C Return Value 38C ____________ 39C 40C The error indicator (INTEGER). 41C 42C Error and Warning Return Values 43C _______________________________ 44C 45C None 46C 47C Common block usage 48C __________________ 49C 50C None 51C 52C EXTERNALS 53C _________ 54C 55C None 56C 57C METHOD 58C ______ 59C 60C The first JPLOOK values are obtained from a look-up table (ZPBES). 61C Any additional values requested are approximated by adding 62C PI (3.14159...) to the previous value. 63C 64C REFERENCE 65C _________ 66C 67C None 68C 69C COMMENTS 70C ________ 71C 72C This routine is adapted from that in the old Marsint library. 73C The interface and the variable names have been modified. 74C 75C Program contains sections 0 to 2 and 9 76C 77C AUTHOR 78C ______ 79C 80C K. Fielding *ECMWF* Oct 1993 81C 82C MODIFICATIONS 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 Implicit statement to force declarations 114C 115 IMPLICIT NONE 116C 117#include "jparams.h" 118C 119C Dummy arguments 120C 121 INTEGER KTRUNC 122C 123 REAL PBESJ0 (*) 124C 125C Local variables 126C 127C 128 INTEGER ILOOK 129 INTEGER JAPPRX, JLOOK 130C 131 REAL ZPBES (JPLOOK) 132C 133 DATA ZPBES / 2.4048255577E0, 5.5200781103E0, 134 1 8.6537279129E0, 11.7915344391E0, 14.9309177086E0, 135 2 18.0710639679E0, 21.2116366299E0, 24.3524715308E0, 136 3 27.4934791320E0, 30.6346064684E0, 33.7758202136E0, 137 4 36.9170983537E0, 40.0584257646E0, 43.1997917132E0, 138 5 46.3411883717E0, 49.4826098974E0, 52.6240518411E0, 139 6 55.7655107550E0, 58.9069839261E0, 62.0484691902E0, 140 7 65.1899648002E0, 68.3314693299E0, 71.4729816036E0, 141 8 74.6145006437E0, 77.7560256304E0, 80.8975558711E0, 142 9 84.0390907769E0, 87.1806298436E0, 90.3221726372E0, 143 A 93.4637187819E0, 96.6052679510E0, 99.7468198587E0, 144 1 102.8883742542E0, 106.0299309165E0, 109.1714896498E0, 145 2 112.3130502805E0, 115.4546126537E0, 118.5961766309E0, 146 3 121.7377420880E0, 124.8793089132E0, 128.0208770059E0, 147 4 131.1624462752E0, 134.3040166383E0, 137.4455880203E0, 148 5 140.5871603528E0, 143.7287335737E0, 146.8703076258E0, 149 6 150.0118824570E0, 153.1534580192E0, 156.2950342685E0 / 150C 151C _______________________________________________________ 152C 153C 154C* Section 1. Extract initial values from look up table 155C 156C _______________________________________________________ 157C 158 100 CONTINUE 159C 160 JBESS = 0 161C 162 ILOOK = MIN(KTRUNC, JPLOOK) 163C 164 DO 110 JLOOK = 1, ILOOK 165 PBESJ0(JLOOK) = ZPBES(JLOOK) 166 110 CONTINUE 167C 168C _______________________________________________________ 169C 170C* Section 2. Approximate any extra values required 171C _______________________________________________________ 172C 173 200 CONTINUE 174C 175 DO 210 JAPPRX = ILOOK + 1, KTRUNC 176 PBESJ0(JAPPRX) = PBESJ0(JPLOOK) + PPI * (JAPPRX - ILOOK) 177 210 CONTINUE 178C 179C _______________________________________________________ 180C 181C* Section 9. Return to calling routine. 182C _______________________________________________________ 183C 184 900 CONTINUE 185C 186 RETURN 187 END 188 189