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 IGLSMR (KILSMN, KILSMS, KOLSM, KNINDEX,
12     1   KSINDEX, KOWE, PWFACT, KPR, KERR)
13C
14C---->
15C**** *IGLSMR*
16C
17C     PURPOSE
18C     -------
19C
20C     Calculate the effects of the land-sea masks for one line of
21C     latitude on the unnormalised interpolation weights.
22C
23C     INTERFACE
24C     ---------
25C
26C     IERR = IGLSMR (KILSMN, KILSMS, KOLSM, KNINDEX, KSINDEX,
27C    1   KOWE, PWFACT, KPR, KERR)
28C
29C     Input parameters
30C     ----------------
31C
32C     KILSMN     - The land sea mask for the line of latitude of the
33C                  input field North of the output row.
34C
35C     KILSMS     - The land sea mask for the line of latitude of the
36C                  input field South of the output row.
37C
38C     KOLSM      - The land sea mask for the current line of latitude
39C                  of the output field.
40C
41C     KNINDEX    - This array contains the array offsets of the West
42C                  and East points in the input line of latitude North
43C                  of the current output field line of latitude.
44C
45C     KSINDEX    - This array contains the array offsets of the West
46C                  and East points in the input line of latitude South
47C                  of the current output field line of latitude.
48C
49C     KOWE       - The number of output field points in the West-East
50C                  direction for this line of latitude.
51C
52C     PWFACT     - The array of interpolating weights to the four
53C                  neighbouring points for every output point in this
54C                  line of latitude.
55C
56C     KPR        - The debug print switch.
57C                  0  , No debugging output.
58C                  1  , Produce debugging output.
59C
60C     KERR       - The error control flag.
61C                  -ve, No error message. Return error code.
62C                  0  , Hard failure with error message.
63C                  +ve, Print error message. Return error code.
64C
65C     Output parameters
66C     ________________
67C
68C     PWFACT     - The modified array of interpolating weights to the
69C                  four neighbouring points for every output point in
70C                  this line of latitude.
71C
72C     Return value
73C     ------------
74C
75C     The error indicator (INTEGER).
76C
77C     Error and Warning Return Values
78C     _______________________________
79C
80C     None
81C
82C     Common block usage
83C     __________________
84C
85C     None
86C
87C     Externals
88C     ---------
89C
90C     INTLOG(R) - Logs messages.
91C
92C
93C     Method
94C     ------
95C
96C     Every time that a point in the input array has a land-sea mask
97C     value (0-1) that does not match the corresponding output point
98C     its interpolating value is multiplied by a scaling factor
99C     (currently 0.2). This reduces the influence of such points on
100C     the final interpolation.
101C
102C     The parameter list is designed to allow for quasi regular input
103C     fields with different grid spacing in the Northern and Southern
104C     lines of latitude.
105C
106C
107C     Reference
108C     ---------
109C     None
110C
111C
112C     Comments
113C     --------
114C     None
115C
116C
117C     AUTHOR
118C     ------
119C     K. Fielding      *ECMWF*      Oct 1993
120C
121C
122C     Modifications
123C     -------------
124C
125C     None
126C
127C----<
128C
129C     -----------------------------------------------------------------|
130C*    Section 0. Definition of variables.
131C     -----------------------------------------------------------------|
132C
133C
134      IMPLICIT NONE
135C
136#include "parim.h"
137C
138C     Dummy arguments
139      INTEGER KOWE, KPR, KERR
140      INTEGER KNINDEX (2, KOWE), KSINDEX (2, KOWE)
141      INTEGER KILSMN (*), KILSMS (*), KOLSM (KOWE)
142      REAL PWFACT (4, KOWE)
143C
144C     Local variables
145      INTEGER JOLON
146C
147C     Multiplication factor for unlike land-sea masks
148C
149      REAL PPLSM
150      PARAMETER (PPLSM = 0.2E0)
151C
152      INTEGER JPROUTINE
153      PARAMETER (JPROUTINE = 25300)
154C
155C     -----------------------------------------------------------------|
156C*    Section 1. Initialisation
157C     -----------------------------------------------------------------|
158C
159  100 CONTINUE
160C
161      IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IGLSMR: Section 1.',JPQUIET)
162C
163      IGLSMR = 0
164C
165      IF (KPR .GE. 1)
166     X  CALL INTLOG(JP_DEBUG,'IGLSMR: No. of output longitudes = ',KOWE)
167C
168C     -----------------------------------------------------------------|
169C*    Section 2. Calculate arrays of weights
170C     -----------------------------------------------------------------|
171C
172  200 CONTINUE
173C
174      IF (KPR.GE.1) CALL INTLOG(JP_DEBUG,'IGLSMR: Section 2.',JPQUIET)
175C
176C     Now modify the unormalised weight for land-sea mask
177C
178      DO 210 JOLON = 1, KOWE
179C
180         IF (KILSMN (KNINDEX (JP_I_W, JOLON)) .NE.
181     1      KOLSM (JOLON) )
182     2         PWFACT (JP_I_NW, JOLON) =
183     3            PWFACT (JP_I_NW, JOLON) * PPLSM
184C
185         IF (KILSMN (KNINDEX (JP_I_E, JOLON)) .NE.
186     1      KOLSM (JOLON) )
187     2         PWFACT (JP_I_NE, JOLON) =
188     3            PWFACT (JP_I_NE, JOLON) * PPLSM
189C
190         IF (KILSMS (KSINDEX (JP_I_W, JOLON)) .NE.
191     1      KOLSM (JOLON) )
192     2         PWFACT (JP_I_SW, JOLON) =
193     3            PWFACT (JP_I_SW, JOLON) * PPLSM
194C
195         IF (KILSMS (KSINDEX (JP_I_E, JOLON)) .NE.
196     1      KOLSM (JOLON) )
197     2         PWFACT (JP_I_SE, JOLON) =
198     3            PWFACT (JP_I_SE, JOLON) * PPLSM
199C
200  210 CONTINUE
201C
202C     -----------------------------------------------------------------|
203C*    Section 9. Return to calling routine. Format statements
204C     -----------------------------------------------------------------|
205C
206  900 CONTINUE
207C
208      IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IGLSMR: Section 9.',JPQUIET)
209C
210      RETURN
211      END
212