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      SUBROUTINE JOPNLL( PLEG, PINTVL, KTRUNC, KUNIT, PBUILD, KRET)
12C
13C---->
14C**** JOPNLL
15C
16C     Purpose
17C     _______
18C
19C     This routine finds a file of legendre polynomials corresponding
20C     to a given grid interval and truncation and returns a unit number.
21C
22C     Interface
23C     _________
24C
25C     CALL JOPNLL( PLEG, PINTVL, KTRUNC, KUNIT, PBUILD, KRET)
26C
27C     Input parameters
28C     ________________
29C
30C     PLEG    - Array for legendre function
31C     PINTVL  - Grid interval in degrees
32C     KTRUNC  - Spherical truncation
33C
34C     Output parameters
35C     _________________
36C
37C     KUNIT   - Unit number from PBOPEN
38C               0 , open failed
39C     PBUILD  - Grid interval used to build the legendre
40C               coefficients file (degrees)
41C     KRET    - Return status code
42C               0 = OK
43C
44C     Common block usage
45C     __________________
46C
47C     None
48C
49C     Method
50C     ______
51C
52C     Builds a file name from the truncation and grid interval and
53C     tries to open a file of that name.
54C
55C     If the file is already open (from a previous call), the
56C     previous unit number is returned.
57C     If a different file is already open (from a previous call), the
58C     existing file is closed first.
59C
60C     If no file can be located, a file is created.
61C
62C     Externals
63C     _________
64C
65C     PBOPEN   - Open binary file and return unit number
66C     PBCLOSE  - Close binary file
67C     JFINDIR  - Find the file of legendre coefficients
68C     JMAKLL   - Makes a file of legendre coefficients
69C     INTLOG   - Output log message
70C     JCHMOD   - Change file permissions
71C     RENAME   - Rename file
72C
73C     Reference
74C     _________
75C
76C     NONE
77C
78C     Comments
79C     ________
80C
81C     The Legendre polynomials for the transforms may be held in
82C     a ready-made file whose name is held in an environment variable:
83C         cf_txxxx_raabbbbb       Txxx   aa.bbbbb degrees
84C     For example,
85C         cf_t0213_r0050000       T213    0.5 degrees
86C         cf_t0106_r0250000       T106    2.5 degrees
87C
88C     On the C90, the file of polynomials may be cached in /owrk/marsint
89C
90C     Otherwise the file is located in (or will be created in) the first
91C     directory given by one of the following (in the order listed, if
92C     they exist):
93C         environment variable PPDIR
94C     or
95C         the current working directory.
96C
97C     Author
98C     ______
99C
100C     J.D.Chambers      *ECMWF*      Nov 1993
101C
102C     Modifications
103C     _____________
104C
105C     J.D.Chambers      *ECMWF*      Mar 1996
106C     Standardise the search order for the environment variables.
107C
108C----<
109C     _______________________________________________________
110C
111      IMPLICIT NONE
112C
113#include "parim.h"
114C
115C     Parameters
116C
117      INTEGER JPROUTINE
118      PARAMETER( JPROUTINE = 30900 )
119C
120C     Subroutine arguments
121C
122      REAL      PLEG, PINTVL, PBUILD
123      DIMENSION PLEG(*)
124      INTEGER   KTRUNC, KUNIT, KRET
125C
126C     Local variables
127C
128      INTEGER IRET, IOFFSET
129      LOGICAL LFOUND
130      CHARACTER*256 DIRNAME
131      CHARACTER*256 FILENAME, FILEDUM
132      CHARACTER*512 FULLPATH
133      CHARACTER*20 YPFN
134      CHARACTER*20 YOLD
135#ifdef REAL_8
136      DATA YPFN/'CF_Txxxx_Raabbbbb'/
137#else
138      DATA YPFN/'cf_txxxx_raabbbbb'/
139#endif
140      DATA YOLD/'xxxxxxxxxxxxxxxxxxxx'/
141      INTEGER NUNIT
142      DATA NUNIT/0/
143C
144      SAVE NUNIT, YOLD
145C
146C     Externals
147C
148      LOGICAL JFINDIR
149      LOGICAL JFINDFN
150      INTEGER JCHMOD, RENAME
151C
152C     _______________________________________________________
153C
154C*    Section 1. See if required file already in use.
155C     _______________________________________________________
156C
157  100 CONTINUE
158C
159C     Setup the file name
160C
161      WRITE(YPFN(5:8),'(I4.4)') KTRUNC
162      WRITE(YPFN(11:17),'(I7.7)') NINT(PINTVL*JPMULT)
163      CALL INTLOG(JP_DEBUG,
164     X  'JOPNLL: Coefficients file to open is:', JPQUIET)
165      CALL INTLOG(JP_DEBUG, YPFN, JPQUIET)
166      PBUILD = PINTVL
167C
168C     If file already open, return the existing unit number
169C
170      IF( YPFN.EQ.YOLD ) THEN
171        CALL INTLOG(JP_DEBUG,'JOPNLL: File already open.',JPQUIET)
172        KUNIT = NUNIT
173        GOTO 900
174      ENDIF
175C
176C     Otherwise, close the existing file
177C
178      IF( NUNIT.NE.0 ) THEN
179        CALL PBCLOSE(NUNIT, IRET)
180        IF( IRET.NE.0 ) THEN
181          CALL INTLOG(JP_ERROR,'JOPNLL: PBCLOSE error',IRET)
182          KRET = JPROUTINE + 1
183          GOTO 990
184        ENDIF
185        NUNIT = 0
186      ENDIF
187C     _______________________________________________________
188C
189C*    Section 2. See if the file has already been created.
190C     _______________________________________________________
191C
192  200 CONTINUE
193C
194C     Set appropriate build inteval
195C
196      WRITE(YPFN(11:17),'(I7.7)') NINT(PBUILD*JPMULT)
197C
198      IOFFSET = INDEX(YPFN,' ') - 1
199      FILENAME = YPFN(1:IOFFSET)
200C
201      LFOUND = JFINDIR('PPDIR', DIRNAME)
202      IF( LFOUND ) THEN
203        LFOUND = JFINDFN(DIRNAME,FILENAME,IOFFSET,NUNIT)
204        IF( LFOUND ) GOTO 500
205      ENDIF
206C
207C     Try present working directory
208C
209      IOFFSET = INDEX(YPFN, ' ') - 1
210      FILENAME = YPFN(1:IOFFSET)
211      CALL PBOPEN( NUNIT, FILENAME(1:IOFFSET), 'r', IRET)
212      IF( IRET.EQ.0 ) GOTO 500
213C     _______________________________________________________
214C
215C*    Section 3. File doesn't exist, find a suitable directory for it.
216C     _______________________________________________________
217C
218  300 CONTINUE
219C
220      LFOUND = JFINDIR('PPDIR', DIRNAME)
221      IF ( LFOUND ) THEN
222        IOFFSET = INDEX(DIRNAME, ' ') - 1
223        FULLPATH = DIRNAME(1:IOFFSET) // '/' // FILENAME
224        IOFFSET = INDEX(FULLPATH, ' ') - 1
225        FILENAME(1:IOFFSET) = FULLPATH(1:IOFFSET)
226        FILEDUM(1:IOFFSET) = FILENAME(1:IOFFSET)
227#ifdef REAL_8
228        FILEDUM(IOFFSET-16:IOFFSET-15) = 'XX'
229#else
230        FILEDUM(IOFFSET-16:IOFFSET-15) = 'xx'
231#endif
232        CALL PBOPEN(NUNIT, FILEDUM(1:IOFFSET), 'w', IRET)
233        IF( IRET.EQ.0 ) GOTO 400
234      ENDIF
235C
236C     Try present working directory
237C
238      IOFFSET = INDEX(YPFN,' ') - 1
239      FILENAME = YPFN(1:IOFFSET)
240      FILEDUM(1:IOFFSET) = FILENAME(1:IOFFSET)
241#ifdef REAL_8
242      FILEDUM(IOFFSET-16:IOFFSET-15) = 'XX'
243#else
244      FILEDUM(IOFFSET-16:IOFFSET-15) = 'xx'
245#endif
246      CALL PBOPEN(NUNIT, FILEDUM(1:IOFFSET), 'w', IRET)
247      IF( IRET.NE.0 ) THEN
248        CALL INTLOG(JP_FATAL,'JOPNLL: PBOPEN error.',IRET)
249        KRET = JPROUTINE + 2
250        GOTO 990
251      ENDIF
252C     _______________________________________________________
253C
254C*    Section 4. Create the coefficients file.
255C     _______________________________________________________
256C
257  400 CONTINUE
258C
259C     Let user know that a new file is being created.
260C
261      IOFFSET = INDEX(FILENAME, ' ') - 1
262      CALL INTLOG(JP_DEBUG,'JOPNLL: Creating new coefficients file:',
263     X            JPQUIET)
264      CALL INTLOG(JP_DEBUG,FILENAME(1:IOFFSET), JPQUIET)
265C
266C     Change access mode to 'read only' for all users.
267C
268      IRET = JCHMOD(FILEDUM(1:IOFFSET),'0444')
269      IF( IRET.NE.0 ) THEN
270        CALL INTLOG(JP_FATAL,'JOPNLL: JCHMOD error.',IRET)
271        KRET = JPROUTINE + 3
272        GOTO 990
273      ENDIF
274C
275C     Make coefficients file
276C
277      CALL JMAKLL( NUNIT, KTRUNC, PBUILD, 0.0, PLEG, KRET)
278      IF( KRET.NE.0 ) GOTO 990
279C
280C     Close it, rename it, re-open for reading, leave it open.
281C
282      CALL PBCLOSE(NUNIT, IRET)
283      IF( IRET.NE.0 ) THEN
284        CALL INTLOG(JP_ERROR,'JOPNLL: PBCLOSE error.',IRET)
285        KRET = JPROUTINE + 4
286        GOTO 990
287      ENDIF
288C
289      FILEDUM(IOFFSET+1:IOFFSET+1) = CHAR(0)
290      FILENAME(IOFFSET+1:IOFFSET+1) = CHAR(0)
291      IRET = RENAME(FILEDUM(1:IOFFSET),FILENAME(1:IOFFSET))
292#ifndef hpR64
293      IF( IRET.NE.0 ) THEN
294        CALL INTLOG(JP_FATAL,'JOPNLL: RENAME of file failed',JPQUIET)
295        KRET = JPROUTINE + 5
296        GOTO 990
297      ENDIF
298#endif
299C
300      CALL PBOPEN(NUNIT, FILENAME(1:IOFFSET), 'r', IRET)
301      IF( IRET.NE.0 ) THEN
302        CALL INTLOG(JP_FATAL,'JOPNLL: PBOPEN error.',IRET)
303        KRET = JPROUTINE + 6
304        GOTO 990
305      ENDIF
306C     _______________________________________________________
307C
308C*    Section 5. File now open with read access.
309C     _______________________________________________________
310C
311  500 CONTINUE
312C
313      KUNIT = NUNIT
314      YOLD  = YPFN
315C
316C     _______________________________________________________
317C
318C*    Section 9. Return to calling routine. Format statements
319C     _______________________________________________________
320C
321  900 CONTINUE
322C
323      KRET = 0
324C
325 990  CONTINUE
326C
327      RETURN
328      END
329