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 ESTIMA()
12C---->
13C**** ESTIMA
14C
15C     Purpose
16C     -------
17C
18C     Calculate size of scratch space required for output field of
19C     interpolation.
20C
21C
22C     Interface
23C     ---------
24C
25C     ISIZE = ESTIMA()
26C
27C
28C     Input
29C     -----
30C
31C     Values in common blocks "nofld.common".
32C
33C
34C     Output
35C     ------
36C
37C     Size as number of values (words).
38C     Returns 0 if output type not recognised.
39C
40C
41C     Method
42C     ------
43C
44C     Depends on output grid type.
45C
46C
47C     Externals
48C     ---------
49C
50C     INTLOG  - Log error message
51C
52C
53C     Author
54C     ------
55C
56C     J.D.Chambers     ECMWF     Feb 1995
57C
58C----<
59C
60      IMPLICIT NONE
61C
62#include "parim.h"
63#include "nifld.common"
64#include "nofld.common"
65C
66      INTEGER TMP
67C
68C     -----------------------------------------------------------------|
69C     Section 1.  Initialise.
70C     -----------------------------------------------------------------|
71C
72  100 CONTINUE
73C
74      ESTIMA = 0
75      TMP = 0
76C
77C     -----------------------------------------------------------------|
78C*    Section 2.   Spherical harmonic field
79C     -----------------------------------------------------------------|
80C
81  200 CONTINUE
82C
83      IF( (NOREPR.EQ.JPSPHERE).OR.
84     X    (NOREPR.EQ.JPSTRSH).OR.
85     X    (NOREPR.EQ.JPSPHROT) ) THEN
86cs        ESTIMA = (NORESO+1) * (NORESO+4)
87        ESTIMA = (NORESO+1) * (NORESO+2)
88        CALL INTLOG(JP_DEBUG,'ESTIMA: spherical harmonic = ',ESTIMA)
89        GOTO 900
90      ENDIF
91C
92C     -----------------------------------------------------------------|
93C*    Section 5.  gaussian field
94C     -----------------------------------------------------------------|
95C
96  500 CONTINUE
97C
98      IF(NOGAUSS.GT.0) THEN
99C       ESTIMA = NOGAUSS * NOGAUSS * 8
100        ESTIMA = (2*NOGAUSS) * (4*NOGAUSS + 20)  ! account for RGG/octahedral
101        CALL INTLOG(JP_DEBUG,'ESTIMA: Gaussian Number = ', NOGAUSS)
102        CALL INTLOG(JP_DEBUG,'ESTIMA: any gaussian= ',ESTIMA)
103        GOTO 900
104      ENDIF
105C
106C     -----------------------------------------------------------------|
107C*    Section 3.   Regular lat/long field
108C     -----------------------------------------------------------------|
109C
110  300 CONTINUE
111C
112      IF( (NOREPR.EQ.JPREGULAR).OR.(NOREPR.EQ.JPREGROT) ) THEN
113        ESTIMA = (JP360/NOGRID(1) + 1) * (JP180 / NOGRID(2) + 1)
114        IF( ABS(NOAREA(4)-NOAREA(2)).GT.0 .AND.
115     X      ABS(NOAREA(3)-NOAREA(1)).GT.0 ) THEN
116C         EMOS-277: extra (+1)*2 for memory allocation (see issue)
117C         ! 2* to consider also vector interpolations (such as vo/d > u/v)
118          TMP = (ABS(NOAREA(4)-NOAREA(2))/NOGRID(1) + 1 + 1)
119     X        * (ABS(NOAREA(3)-NOAREA(1))/NOGRID(2) + 1 + 1)
120          TMP = 2*TMP
121          IF (ESTIMA>TMP) ESTIMA = TMP
122        ENDIF
123        CALL INTLOG(JP_DEBUG,'ESTIMA: Regular lat/long = ',ESTIMA)
124      ENDIF
125
126      IF(NILOCAL.EQ.4) THEN
127        IF(NOGRID(1).GT.0.AND.NOGRID(1).GT.0) THEN
128          ESTIMA = (JP360/NOGRID(1) + 1) * (JP180 / NOGRID(2) + 1)*2
129        ELSE
130          ESTIMA = 36099382
131        ENDIF
132        CALL INTLOG(JP_DEBUG,'ESTIMA: OCEAN field = ',ESTIMA)
133      ENDIF
134C
135C     -----------------------------------------------------------------|
136C*    Section 9.   Return
137C     -----------------------------------------------------------------|
138C
139  900 CONTINUE
140C
141      CALL INTLOG(JP_DEBUG,
142     X  'ESTIMA: number of points in output field = ',ESTIMA)
143C
144      RETURN
145      END
146