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