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 IBASINI(KFORCE)
12C
13C---->
14C**** IBASINI
15C
16C     Purpose
17C     -------
18C
19C     Ensures basic initialisation of common blocks is done
20C
21C     Interface
22C     ---------
23C
24C     IRET = IBASINI(KFORCE)
25C
26C
27C     Input parameters
28C     ----------------
29C
30C     KFORCE  = 1, to force initialisation of common blocks.
31C             = 0, to check if initialisation of common blocks is done
32C                  already (and do it if not already done).
33C
34C
35C     Method
36C     ------
37C
38C     NJDCDOT in nifld.common is checked/set.
39C
40C     Looks for environment variable INTERP_GEN_COEFFS which gives
41C     the name of a file containing the cutoff spectral truncation
42C     above which interpolation coefficients are generated 'on the
43C     fly'. Variable NICOMP is set with this value in nifld.common.
44C     The file contains entries for each computer architecture in
45C     format:
46C
47C       col 1
48C         |
49C         v
50C         FUJITSU 319
51C         sgimips 213
52C         hppa 213
53C         DEFAULT 106
54C
55C     If no matching $ARCH value, the DEFAULT value is used.
56C     If no matching $ARCH and no DEFAULT value, a hard-code value is used.
57C
58C     Looks for environment variable USE_HIRLAM_12POINT to determine
59C     whether or not the Hiralm 12-point horizontal interpolation is
60C     to be used for rotations.
61C
62C
63C     Externals
64C     ---------
65C
66C     CLEAR_C - Clear common block variables
67C     GETENV  - Get value of an environment variable
68C     JINDEX  - Returns length of character string
69C
70C
71C     Author
72C     ------
73C
74C     J.D.Chambers       ECMWF        August 1994.
75C
76C----<
77C
78C     -----------------------------------------------------------------|
79C
80      IMPLICIT NONE
81C
82#include "parim.h"
83#include "nifld.common"
84#include "nofld.common"
85#include "intf.h"
86C
87C     Function arguments
88C
89      INTEGER KFORCE
90C
91C     Local variables
92C
93      CHARACTER*120 LINE
94      CHARACTER*20 ARCH, USEHIR
95      CHARACTER*256 CONFIG
96      INTEGER IMAGIC, IRET, ICONFIG, IBLANK, LOOP
97      DATA ICONFIG/69/
98      DATA IMAGIC/1952999238/
99C
100C     Externals
101C
102      INTEGER JINDEX
103C
104C     -----------------------------------------------------------------|
105C     Section 1. Force initialisation if requested.
106C     -----------------------------------------------------------------|
107C
108  100 CONTINUE
109C
110      IF ( KFORCE .EQ. 1 ) NJDCDOT = 0
111C
112C     See if basic initialisation has already been done or not
113C
114      IF ( NJDCDOT .NE. IMAGIC ) THEN
115C
116C       Clear common block variables
117C
118        CALL CLEAR_C()
119C
120        IRET = 1
121        CALL IAINIT(0,IRET)
122C
123C       Set interpolation handling default values
124C       (Replaces old call to rddefs)
125C
126        NILOCAL = 0
127        NISTREM = 0
128        NIFORM = 1
129        NOFORM = 1
130        NITABLE = 128
131        NOTABLE = 128
132        NIPARAM = 0
133        DO LOOP = 1,4
134          NIAREA(LOOP) = 0
135          NOAREA(LOOP) = 0
136        ENDDO
137        NISCNM = 0
138        NOSCNM = 0
139C
140C       Set default value for truncation above which interpolation
141C       coefficients are to be computed dynamically
142C
143        NICOMP = 319
144C
145C       Now see if this default value has been modified in a
146C       configuration file
147C
148        CALL GETENV('INTERP_GEN_COEFFS', CONFIG)
149        IBLANK = JINDEX(CONFIG)
150        IF( IBLANK.GE.1 ) THEN
151C
152C         Open the configuration file
153C
154          OPEN( ICONFIG, FILE=CONFIG, STATUS='OLD', ERR=200)
155          CALL GETENV('ARCH', ARCH)
156          IBLANK = JINDEX(ARCH)
157          IF( IBLANK.LT.1 ) ARCH = 'DEFAULT'
158          IBLANK = JINDEX(ARCH)
159C
160C         Look for matching 'arch'
161C
162  110     CONTINUE
163          READ( ICONFIG, '(A)', END= 200) LINE
164          IF( ARCH(1:IBLANK).EQ.LINE(1:IBLANK) ) THEN
165            READ(LINE(IBLANK+1:),'(1X,I3)') NICOMP
166            GOTO 200
167          ENDIF
168C
169C         Pickup default (will be used if no matching 'arch')
170C
171          IF( (LINE(1:7).EQ.'DEFAULT').OR.
172     X        (LINE(1:7).EQ.'default') )
173     X      READ(LINE(IBLANK+1:),'(1X,I3)') NICOMP
174C
175          GOTO 110
176        ENDIF
177C
178C     -----------------------------------------------------------------|
179C     Section 2. See if Hirlam 12-point horizontal interpolation to be
180C                use for rotations (default = 'yes').
181C     -----------------------------------------------------------------|
182C
183  200   CONTINUE
184C
185        LUSEHIR = .TRUE.
186        CALL GETENV('USE_HIRLAM_12POINT', USEHIR)
187        IF( (USEHIR(1:3).EQ.'OFF').OR.(USEHIR(1:2).EQ.'NO') )
188     X    LUSEHIR = .FALSE.
189C
190C     -----------------------------------------------------------------|
191C     Section 9. Return
192C     -----------------------------------------------------------------|
193C
194  900   CONTINUE
195C
196C       Set 'magic number' to show basic initialisation has been done
197C
198        NJDCDOT = IMAGIC
199C
200      ENDIF
201C
202      IBASINI = 0
203C
204      RETURN
205      END
206