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