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
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
|
C Copyright 1981-2007 ECMWF
C
C Licensed under the GNU Lesser General Public License which
C incorporates the terms and conditions of version 3 of the GNU
C General Public License.
C See LICENSE and gpl-3.0.txt for details.
C
LOGICAL FUNCTION PPALLOW(NM,SLAT)
C
C---->
C**** PPALLOW
C
C Purpose
C -------
C
C
C ---------
C
C LFOUND = PPALLOW(NM,SLAT)
C
C
C Input
C -----
C
C NM - Triangular truncation number of the field..
C SLAT - Rotation angle (degrees, REAL*8)
C (degrees, negative => rotate counter-clockwise about the
C new Z-axis).
C
C
C Output
C ------
C
C Function returns .TRUE. if coefficients are in the list of
C 'standard' rotations and allowed in mrfs.
C
C
C Method
C ------
C
C Checks a configuration file to find the allowed rotations.
C This file may have its pathname given by the environment variable
C PP_ALLOWED_ROTATIONS or may be in a standard directory.
C Only picks up configuration values on first call.
C
C The configuration file is read by Fortran and has format
C (I4,1X,F8). Eg.
C
C 159 -14.0000
C 319 60.0000
C 319 -60.0000
C
C Externals
C ---------
C
C GETENV - Gets value in an environment variable.
C INTLOG - Output log message.
C JDEBUG - Checks environment to switch on/off debug.
C
C
C Author
C ------
C
C J.D.Chambers ECMWF June 2000
C
C
C----<
C -----------------------------------------------------------------|
C
IMPLICIT NONE
C
#include "jparams.h"
#include "parim.h"
C
C Function arguments.
C
INTEGER NM
REAL*8 SLAT
C
C Parameters.
C
INTEGER JPLIST, JPDEFL
PARAMETER (JPLIST = 20 )
C = number of values which can be read
C
PARAMETER (JPDEFL = 3 )
C = number of values in default list
C
C Local variables.
C
INTEGER FILENM, LOOP, LISTLEN
INTEGER NMDEF(JPDEFL), INM(JPLIST)
REAL*8 SLATDEF(JPDEFL), XLAT(JPLIST)
CHARACTER*256 FILENAME
CHARACTER*80 STANDARD
CHARACTER*16 HOST
LOGICAL LDEBUG, LFOUND
C
C Externals
C
DATA NMDEF/159,319,319/, SLATDEF/-14.0,60.0,-60.0/
DATA LDEBUG/.FALSE./, LFOUND/.FALSE./
DATA FILENM/65/
C
SAVE LDEBUG, LFOUND, INM, XLAT, LISTLEN
C
C -----------------------------------------------------------------|
C* Section 1. Initialise
C -----------------------------------------------------------------|
C
100 CONTINUE
C
PPALLOW = .FALSE.
C
C Only pick up configuration values on first call
C
IF( LFOUND ) GOTO 400
C
LFOUND = .TRUE.
C
CALL JDEBUG()
LDEBUG = NDBG.GT.0
C
C -----------------------------------------------------------------|
C* Section 2. Open the configuration file
C -----------------------------------------------------------------|
C
200 CONTINUE
C
C If the environment variable points to a file, try to open it.
C Otherwise, get the file from a standard directory.
C
CALL GETENV('PP_ALLOWED_ROTATIONS', FILENAME)
IF( FILENAME(1:1).NE.' ' ) THEN
IF( LDEBUG) CALL INTLOG(JP_DEBUG,
X 'PPALLOW: Trying to open file '//FILENAME,JPQUIET)
OPEN( FILENM, FILE=FILENAME, STATUS='OLD', ERR=300)
C
ELSE
C
CALL GETENV('HOST',HOST)
IF( HOST(1:7).EQ.'vpp5000') THEN
STANDARD = '/vpp5000/mrfs/postproc/pp_allowed_rotations'
ELSE IF (HOST(1:7).EQ.'vpp700e') THEN
STANDARD = '/vpp700e/mrfs/postproc/pp_allowed_rotations'
ELSE IF (HOST(1:6).EQ.'vpp700') THEN
STANDARD = '/vpp700/mrfs/postproc/pp_allowed_rotations'
ELSE
STANDARD = '/home/ma/emos/data/pp_allowed_rotations'
ENDIF
IF( LDEBUG) CALL INTLOG(JP_DEBUG,
X 'PPALLOW: Trying to open file '//STANDARD,JPQUIET)
OPEN( FILENM, FILE=STANDARD, STATUS='OLD', ERR=300)
ENDIF
C
IF( LDEBUG) CALL INTLOG(JP_DEBUG, 'PPALLOW: Open OK.',JPQUIET)
LISTLEN = 0
C
210 CONTINUE
C
LISTLEN = LISTLEN + 1
READ(FILENM,'(I4,1X,F8.4)',END=220) INM(LISTLEN), XLAT(LISTLEN)
GOTO 210
C
220 CONTINUE
CLOSE(FILENM)
LISTLEN = LISTLEN - 1
C
GOTO 400
C
C -----------------------------------------------------------------|
C* Section 3. Use the internally defined values.
C -----------------------------------------------------------------|
C
300 CONTINUE
C
IF( LDEBUG) THEN
CALL INTLOG(JP_DEBUG,
X 'PPALLOW: No configuration file available.',JPQUIET)
CALL INTLOG(JP_DEBUG,
X 'PPALLOW: Using internally defined values.',JPQUIET)
ENDIF
C
DO LOOP = 1, JPDEFL
INM(LOOP) = NMDEF(LOOP)
XLAT(LOOP) = SLATDEF(LOOP)
ENDDO
LISTLEN = JPDEFL
C
C -----------------------------------------------------------------|
C* Section 4. Check the current values against the list.
C -----------------------------------------------------------------|
C
400 CONTINUE
C
DO LOOP = 1, LISTLEN
IF( (NM.EQ.INM(LOOP)).AND.(SLAT.EQ.XLAT(LOOP)) ) THEN
IF( LDEBUG) THEN
CALL INTLOG(JP_DEBUG,
X 'PPALLOW: Rotation allowed in mrfs.',JPQUIET)
CALL INTLOG(JP_DEBUG, 'PPALLOW: Truncation = ',NM)
CALL INTLOGR(JP_DEBUG,'PPALLOW: Rotation = ', SLAT)
ENDIF
PPALLOW = .TRUE.
GOTO 900
ENDIF
ENDDO
C
IF( LDEBUG ) THEN
CALL INTLOG(JP_DEBUG,
X 'PPALLOW: Rotation NOT allowed in mrfs.',JPQUIET)
CALL INTLOG(JP_DEBUG, 'PPALLOW: Truncation = ',NM)
CALL INTLOGR(JP_DEBUG,'PPALLOW: Rotation = ', SLAT)
ENDIF
C
C -----------------------------------------------------------------|
C* Section 9. Return.
C -----------------------------------------------------------------|
C
900 CONTINUE
C
RETURN
END
|
