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 KRG2RGU(OLDFLD, NEWFLD, NUMGGO, NUMGGN)
12C
13C---->
14C**** KRG2RGU
15C
16C     Purpose
17C     -------
18C
19C     Interpolate a field based on one reduced gaussian grid to a
20C     field based on a different reduced gaussian grid.
21C
22C
23C     Interface
24C     ---------
25C
26C     IRET = KRG2RGU(OLDFLD, NEWFLD, NUMGGO, NUMGGN)
27C
28C     Input
29C     -----
30C
31C     OLDFLD - Old field as array of values
32C     NUMGGO - Number of the old gaussian field
33C     NUMGGN - Number of the new gaussian field
34C
35C
36C     Output
37C     ------
38C
39C     NEWFLD - New field as array of values
40C
41C     Function returns:
42C       - the size in bytes of the new GRIB product if all is well
43C       - -1, otherwise.
44C
45C
46C     Method
47C     ------
48C
49C     Create new field and leave it unpacked.
50C
51C
52C     Externals
53C     ---------
54C
55C     KINTRG  - Interpolate reduced gaussian field to reduced gaussian
56C     INTLOG  - Log messages
57C
58C
59C     Author
60C     ------
61C
62C     J.D.Chambers     ECMWF     February 2002
63C
64C     Modifications
65C     -------------
66C
67C     Use grid definition from input GRIB header to
68C     cater for octahedral grid
69C     S.Siemen         ECMWF     April 2015
70C
71C----<
72C
73      IMPLICIT NONE
74C
75C     Function arguments
76C
77      INTEGER NUMGGO, NUMGGN
78      REAL OLDFLD(*), NEWFLD(*)
79C
80#include "parim.h"
81#include "nofld.common"
82#include "grfixed.h"
83C
84C     Parameters
85C
86      INTEGER JPINTB
87      INTEGER JSEC2
88      PARAMETER (JSEC2 = 5000)
89#ifdef INTEGER_8
90      PARAMETER (JPINTB = 8)
91#else
92      PARAMETER (JPINTB = 4)
93#endif
94C
95C     Local variables
96C
97      INTEGER OLDGEO(JSEC2), NEWGEO(JSEC2)
98      INTEGER LOOP
99      CHARACTER*1 HTYPE
100      REAL PLAT(JPMAXNG)
101C
102      INTEGER IRET
103C
104C     Externals
105C
106      INTEGER KINTRG
107      EXTERNAL KINTRG
108C
109C     -----------------------------------------------------------------|
110C*    Section 1.   Initialise
111C     -----------------------------------------------------------------|
112C
113  100 CONTINUE
114C
115      KRG2RGU = 0
116C
117      IF( (NUMGGN*2).GT.JPMAXNG ) THEN
118        CALL INTLOG(JP_ERROR,'KRG2RGU: Gaussian N too big = ',NUMGGN)
119        CALL INTLOG(JP_ERROR,'KRG2RGU: Maximum handled = ',(JPMAXNG/2))
120        KRG2RGU = -1
121        GOTO 900
122      ENDIF
123C
124C     -----------------------------------------------------------------|
125C*    Section 2.   Create input and new field.
126C     -----------------------------------------------------------------|
127C
128  200 CONTINUE
129C
130      OLDGEO(1:JPMAXNG) = 0
131      DO LOOP = 1, 2*NUMGGO
132        OLDGEO(22+LOOP) = MILLEN(LOOP)
133      ENDDO
134      HTYPE = 'U'
135      CALL JGETGG(NUMGGO,HTYPE,PLAT,OLDGEO(23),IRET)
136      IF( IRET.NE.0 ) THEN
137        WRITE(*,*) 'KRG2RGU: Problem calling JGETGG, status = ',IRET
138        KRG2RGU = -1
139      RETURN
140      ENDIF
141
142C
143      OLDGEO(3)  = NUMGGO * 2
144      OLDGEO(4)  = NINT(PLAT(1)*1000.0)
145      OLDGEO(5)  = 0
146      OLDGEO(7)  = NINT(PLAT(NUMGGO*2)*1000.0)
147c     EMOS-199: adjusted for reduced_gg/octahedral
148c     OLDGEO(8)  = NINT((360.0-(360.0/REAL(NUMGGO*4)))*1000.0)
149      OLDGEO(8)  = NINT((360.0-(360.0/REAL(OLDGEO(23+NUMGGO))))*1000.0)
150      OLDGEO(10) = NUMGGO
151C
152      DO LOOP = 1, JPMAXNG
153        NEWGEO(LOOP) = 0
154      ENDDO
155      HTYPE = 'R'
156      IF( LOCTAHEDRAL ) HTYPE = 'O'
157      CALL JGETGG(NUMGGN,HTYPE,PLAT,NEWGEO(23),IRET)
158      IF( IRET.NE.0 ) THEN
159        WRITE(*,*) 'KRG2RGU: Problem calling JGETGG, status = ',IRET
160        KRG2RGU = -1
161        RETURN
162      ENDIF
163      NEWGEO(3)  = NUMGGN * 2
164      NEWGEO(4)  = NINT(PLAT(1)*1000.0)
165      NEWGEO(5)  = 0
166      NEWGEO(7)  = NINT(PLAT(NUMGGN*2)*1000.0)
167c     EMOS-199: adjusted for reduced_gg/octahedral
168c     NEWGEO(8)  = NINT((360.0-(360.0/REAL(NUMGGN*4)))*1000.0)
169      NEWGEO(8)  = NINT((360.0-(360.0/REAL(NEWGEO(23+NUMGGN))))*1000.0)
170      NEWGEO(10) = NUMGGN
171C
172      IRET = KINTRG(OLDGEO, NEWGEO, OLDFLD, NEWFLD)
173C
174      IF( IRET.LE.0 ) THEN
175        WRITE(*,*) 'KRG2RGU: New field creation failed'
176        KRG2RGU = -1
177        RETURN
178      ENDIF
179c sinisa for merging with grib_api
180      NONS = 2*NOGAUSS
181      NOAAPI(1) = NOAREA(1)
182      NOAAPI(2) = NOAREA(2)
183      NOAAPI(3) = NOAREA(3)
184      NOAAPI(4) = NOAREA(4)
185C
186cs      KRG2RGU = IRET * JPINTB
187cs this is the outlen
188      KRG2RGU = IRET
189C
190C     -----------------------------------------------------------------|
191C*    Section 9.   Return
192C     -----------------------------------------------------------------|
193C
194  900 CONTINUE
195C
196      RETURN
197      END
198