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      LOGICAL FUNCTION ISSAME()
12C
13C---->
14C**** ISSAME
15C
16C     Purpose
17C     -------
18C
19C     Check if output field will be the same as the input field.
20C
21C
22C     Interface
23C     ---------
24C
25C     LSAME = ISSAME()
26C
27C     Input
28C     -----
29C
30C     Values in common block.
31C
32C
33C     Output
34C     ------
35C
36C     Returns .TRUE. if the fields will be the same.
37C
38C
39C     Method
40C     ------
41C
42C     Checks interpolation request flags in common blocks.
43C
44C
45C     Externals
46C     ---------
47C
48C     None.
49C
50C
51C     Author
52C     ------
53C
54C     J.D.Chambers     ECMWF
55C
56C----<
57C     -----------------------------------------------------------------|
58C
59      IMPLICIT NONE
60C
61#include "parim.h"
62#include "nifld.common"
63#include "nofld.common"
64#include "grfixed.h"
65C
66C     Local variables
67C
68      INTEGER IDIFF
69      LOGICAL LDEFIN, LDEFOUT, LSUBAREA
70C
71C     Externals
72C
73      LOGICAL ISSAMEIARRAY, ISSAMERARRAY
74      EXTERNAL ISSAMEIARRAY, ISSAMERARRAY
75C
76C     -----------------------------------------------------------------|
77C
78      ISSAME = .TRUE.
79C
80C     Exit if no postprocessing specified.
81C
82      IF( .NOT.LINTOUT ) THEN
83        CALL INTLOG(JP_DEBUG,
84     X    'ISSAME: No postprocessing specified.',JPQUIET)
85        RETURN
86      ENDIF
87
88C
89C     Set logicals true if default input/output areas specified.
90C
91      LDEFIN  = ( (NIAREA(1).EQ.0) .AND. (NIAREA(2).EQ.0) .AND.
92     X            (NIAREA(3).EQ.0) .AND. (NIAREA(4).EQ.0) )
93      LDEFOUT = ( (NOAREA(1).EQ.0) .AND. (NOAREA(2).EQ.0) .AND.
94     X            (NOAREA(3).EQ.0) .AND. (NOAREA(4).EQ.0) )
95C
96C     Set flag if a subarea has been requested
97C
98      LSUBAREA = (.NOT.LDEFIN .AND. .NOT.LDEFOUT) .AND.
99     X           ( (NOAREA(1).LT.NIAREA(1)).OR.
100     X             (NOAREA(2).GT.NIAREA(2)).OR.
101     X             (NOAREA(3).GT.NIAREA(3)).OR.
102     X             (NOAREA(4).LT.NIAREA(4)) )
103C
104C
105C     Check for rotation
106C
107      IF( (NOROTA(1).NE.0) .OR. (NOROTA(2).NE.0) ) ISSAME = .FALSE.
108C
109C     Check for same formats, representation and bit packing accuracy.
110C
111cs      IF( NIFORM.NE.NOFORM) ISSAME = .FALSE.
112      IF( NIREPR.NE.NOREPR) ISSAME = .FALSE.
113
114      IF( (NOREPR.EQ.JPQUASI).AND.(NIREPR.EQ.JPQUASI) ) THEN
115        ISSAME = ISSAMEIARRAY(NIGAUSS,MILLEN, NOGAUSS,NOLPTS)
116     X     .AND. ISSAMERARRAY(NIGAUSS,RIGAUSS,NOGAUSS,ROGAUSS)
117        IF (ISSAME) THEN
118          CALL INTLOG(JP_DEBUG,
119     X      'ISSAME: Input and output are Reduced Gaussian',JPQUIET)
120          CALL INTLOG(JP_DEBUG,
121     X      'ISSAME: with the same PL and latitudes arrays;',JPQUIET)
122          CALL INTLOG(JP_DEBUG,
123     X      'ISSAME: no postprocessing required.',JPQUIET)
124          RETURN
125        ENDIF
126      ENDIF
127
128      IF( (NOREPR.EQ.JPGAUSSIAN) .AND. (NIREPR.EQ.JPGAUSSIAN) ) THEN
129        IF( (NIGAUSS.EQ.NOGAUSS) .AND. (.NOT.LSUBAREA) ) THEN
130          ISSAME = .TRUE.
131          CALL INTLOG(JP_DEBUG,
132     X      'ISSAME: Input and output are Regular Gaussian',JPQUIET)
133          CALL INTLOG(JP_DEBUG,
134     X      'ISSAME: with the same resolution and area;',JPQUIET)
135          CALL INTLOG(JP_DEBUG,
136     X      'ISSAME: no postprocessing required.',JPQUIET)
137          RETURN
138        ENDIF
139      ENDIF
140C
141C     If input is quasi gaussian and output required to be the same (ie
142C     'gaussian' specified via CALL INTOUT('gaussian', ...) ), change
143C     output to regular gaussian unless same resolution requested.
144C
145      IF( (NOREPR.EQ.JPNOTYPE) .AND.
146     X    (NIGAUSS.NE.NOGAUSS) ) THEN
147        CALL INTLOG(JP_DEBUG,
148     X    'ISSAME: Input is quasi gaussian and output required',JPQUIET)
149        CALL INTLOG(JP_DEBUG,
150     X    'ISSAME: not the same resolution;',JPQUIET)
151        CALL INTLOG(JP_DEBUG,
152     X    'ISSAME: change output to regular gaussian.',JPQUIET)
153        NOREPR = JPGAUSSIAN
154      ENDIF
155C
156C     If input is quasi gaussian and output required to be the same (ie
157C     'gaussian' specified via CALL INTOUT('gaussian', ...) ), change
158C     output to regular gaussian if subarea requested.
159C
160      IF( (NOREPR.EQ.JPNOTYPE) .AND. LSUBAREA ) THEN
161        CALL INTLOG(JP_DEBUG,
162     X    'ISSAME: Input is quasi gaussian and output required',JPQUIET)
163        CALL INTLOG(JP_DEBUG,
164     X    'ISSAME: has a subarea;',JPQUIET)
165        CALL INTLOG(JP_DEBUG,
166     X    'ISSAME: change output to regular gaussian.',JPQUIET)
167        NOREPR = JPGAUSSIAN
168      ENDIF
169C
170C     Exit if both input and output are regular gaussian with
171C     the same resolution and area, since no
172C     postprocessing is required.
173C
174      IF( (NIREPR.EQ.JPGAUSSIAN) .AND.
175     X    (NOREPR.EQ.JPGAUSSIAN) .AND.
176     X    (NIGAUSS.EQ.NOGAUSS)   .AND.
177     X    (.NOT.LSUBAREA)       ) THEN
178        CALL INTLOG(JP_DEBUG,
179     X    'ISSAME: Input and output are regular gaussian with',JPQUIET)
180        CALL INTLOG(JP_DEBUG,
181     X    'ISSAME: the same resolution and area;',JPQUIET)
182        CALL INTLOG(JP_DEBUG,
183     X    'ISSAME: no postprocessing is required.',JPQUIET)
184        RETURN
185      ENDIF
186C
187C     If spherical, check for same truncation.
188C
189      IF( (NIREPR.EQ.JPSPHERE) .AND.
190     X    (NOREPR.EQ.JPSPHERE) .AND.
191     X    (NIRESO.NE.NORESO)   ) ISSAME = .FALSE.
192C
193C     If lat.long, check for same grid intervals and area.
194C
195      IF( (NIREPR.EQ.JPREGULAR) .AND.
196     X    (NOREPR.EQ.JPREGULAR) .AND.
197     X    (NOGRID(1).NE.0)      ) THEN
198        IF( NIGRID(1).NE.NOGRID(1)) ISSAME = .FALSE.
199        IF( NIGRID(2).NE.NOGRID(2)) ISSAME = .FALSE.
200      ENDIF
201      IF( LSUBAREA ) ISSAME = .FALSE.
202C
203cs      IF( (NIREPR.EQ.JPREDLL) .AND.
204cs     X    (NOREPR.EQ.JPREDLL)
205cs     X    (NIGRID(2).NE.NOGRID(2)) ) ISSAME = .FALSE.
206C
207C     Check if areas are same unless defaults given.
208C
209      IF( (.NOT.LDEFIN) .AND. (.NOT.LDEFOUT) ) THEN
210        IF( (NOGRID(1).NE.0) .OR. (NOGRID(2).NE.0) ) THEN
211C
212          IF( NIAREA(1).NE.NOAREA(1)) ISSAME = .FALSE.
213C
214          IDIFF = NIAREA(2) - NOAREA(2)
215          IF( (IDIFF.NE.0) .AND. (IDIFF.NE.JP360) ) ISSAME = .FALSE.
216C
217          IF( NIAREA(3).NE.NOAREA(3) ) ISSAME = .FALSE.
218C
219          IDIFF = NIAREA(4) - NOAREA(4)
220          IF( (IDIFF.NE.0) .AND. (IDIFF.NE.JP360) ) ISSAME = .FALSE.
221        ENDIF
222      ENDIF
223C
224C     If gaussian, check for same grid specification.
225C
226      IF( (NIREPR.EQ.JPGAUSSIAN) .AND. (NOREPR.EQ.JPGAUSSIAN) ) THEN
227        ISSAME = (NIGAUSS.EQ.NOGAUSS)
228      ENDIF
229      IF( (NIREPR.EQ.JPQUASI) .AND. (NOREPR.EQ.JPQUASI) ) THEN
230        ISSAME = ISSAMEIARRAY(NIGAUSS,MILLEN, NOGAUSS,NOLPTS)
231     X     .AND. ISSAMERARRAY(NIGAUSS,RIGAUSS,NOGAUSS,ROGAUSS)
232      ENDIF
233C
234C     Check for same scanning mode.
235C
236C Sinisa commented scanning mode checking because of UK fields
237c      IF( NISCNM.NE.NOSCNM) ISSAME = .FALSE.
238C
239C     Check for same table number, parameter number, level number and
240C     level type.
241C
242cs      IF( NITABLE.NE.NOTABLE) ISSAME = .FALSE.
243cs      IF( NIPARAM.NE.NOPARAM) ISSAME = .FALSE.
244cs      IF( NILEVEL.NE.NOLEVEL) ISSAME = .FALSE.
245cs      IF( NILEVT .NE.NOLEVT ) ISSAME = .FALSE.
246C
247      IF( ISSAME ) RETURN
248C
249C     -----------------------------------------------------------------|
250C
251      RETURN
252      END
253