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 LSM_RED( KGAUSS, KDATE, KBITS, HPATH )
12C
13C---->
14C**** LSM_RED
15C
16C     PURPOSE
17C     -------
18C
19C     Generates the land sea mask file pathname.
20C
21C
22C     INTERFACE
23C     ---------
24C
25C     IRET = LSM_RED( KGAUSS, KDATE, KBITS, HPATH )
26C
27C
28C     Input
29C     -----
30C     KGAUSS - The gaussian number (80 or 160)
31C     KDATE  - The data date in YYYYMMDD format.
32C     KBITS  - Number of bits per land-sea mask value (eg 32 or 64)
33C
34C     Output
35C     ------
36C     HPATH  - The full file pathname (with gaussian number
37C              number of bits and date).
38C
39C
40C     Return value
41C     ------------
42C
43C     Function returns the number of characters in the file pathname,
44C     or zero if no match found.
45C
46C
47C     Common block usage
48C     ------------------
49C
50C     None
51C
52C
53C     EXTERNALS
54C     ---------
55C
56C     GETENV     - Standard routine to get environmental variable.
57C     INDEX      - Intrinsic routine to find position of substring.
58C     EMOSNUM    - Gives current EMOSLIB version number.
59C
60C
61C     METHOD
62C     ------
63C     None
64C
65C
66C     REFERENCE
67C     ---------
68C
69C     None
70C
71C     COMMENTS
72C     --------
73C
74C     None
75C
76C
77C     AUTHOR
78C     ------
79C
80C     J.D.Chambers      *ECMWF*      ??? 1996
81C
82C
83C     MODIFICATIONS
84C     -------------
85C
86C     J.D.Chambers      *ECMWF*      July 1998
87C     Use dates in YYYYMMDD format to handle year 2000 etc.
88C
89C----<
90C     _______________________________________________________
91C
92C*    Section 0. Definition of variables.
93C     _______________________________________________________
94C
95      IMPLICIT NONE
96C
97C     Parameters
98C
99      INTEGER JPD160, JPD80
100      PARAMETER (JPD160=6)
101      PARAMETER (JPD80=2)
102C
103C     Function parameters
104C
105      INTEGER KGAUSS, KDATE, KBITS
106      CHARACTER*(*) HPATH
107C
108C     Local variables
109C
110      INTEGER LOOP
111C
112C     External functions
113C
114      INTEGER DPATH_TABLES_INTERPOL
115      EXTERNAL DPATH_TABLES_INTERPOL
116C
117C     Change dates for N160
118C
119      INTEGER DATE160(JPD160)
120      DATA DATE160/
121     X            19790930,
122     X            19910917,
123     X            19930804,
124     X            19940302,
125     X            19940823,
126     X            19950404
127     X           /
128C
129C     Change dates for N80
130C
131      INTEGER DATE80(JPD80)
132      DATA DATE80/
133     X            19790930,
134     X            19790930
135     X           /
136C
137      CHARACTER*256 YBASE
138      INTEGER IBASELEN
139
140      CHARACTER*50 PATH160(JPD160)
141      CHARACTER*50 PATH80(JPD80)
142C
143C     Pathnames for N160
144C
145      DATA PATH160/
146     X            '_19790930',
147     X            '_19910917',
148     X            '_19930804',
149     X            '_19940302',
150     X            '_19940823',
151     X            '_19950404'
152     X          /
153C
154C
155C     Pathnames for N80
156      DATA PATH80/
157     X            '_19790930',
158     X            '_19790930'
159     X          /
160C
161      INTEGER INDEX
162C
163C     External functions
164C
165      INTEGER EMOSNUM
166      EXTERNAL EMOSNUM
167C
168C***************************************************************
169C     Section 1. Initialize and check input values.
170C***************************************************************
171C
172  100 CONTINUE
173C
174      LSM_RED = 0
175      HPATH = ' '
176C
177C     Only reduced N160 gaussian fields handled.
178C
179      IF( KGAUSS.NE.160 ) GOTO 900
180C
181C     Only 32 bit and 64 bit land-sea masks handled.
182C
183      IF( (KBITS.NE.32).AND.(KBITS.NE.64) ) GOTO 900
184C
185C     Check environment variable for path of land sea masks.
186C     (no error is raised, since 0 is a possible resulting value)
187C
188      IBASELEN = DPATH_TABLES_INTERPOL(YBASE)
189C
190C***************************************************************
191C     Section 2. Build pathnames.
192C***************************************************************
193C
194  200 CONTINUE
195C
196C     Handle N160
197C
198      IF( KGAUSS.EQ.160 ) THEN
199        DO 210 LOOP = 1, JPD160-1
200          IF( (KDATE.GE.DATE160(LOOP) ) .AND.
201     X         (KDATE.LT.DATE160(LOOP+1)) ) THEN
202            HPATH(1:) = YBASE(1:IBASELEN) //
203     X                  'r160_' // 'xx' // PATH160(LOOP)
204            LSM_RED = INDEX(HPATH,' ')
205            GOTO 900
206          ENDIF
207  210   CONTINUE
208C
209C       Dropthrough -> take latest.
210C
211        HPATH(1:) = YBASE(1:IBASELEN) //
212     X              'r160_' // 'xx' // PATH160(JPD160)
213        LSM_RED = INDEX(HPATH,' ')
214C
215C     Handle N80
216C
217      ELSE
218        DO 220 LOOP = 1, JPD80-1
219          IF( (KDATE.GE.DATE80(LOOP) ) .AND.
220     X         (KDATE.LT.DATE80(LOOP+1)) ) THEN
221            HPATH(1:) = YBASE(1:IBASELEN) //
222     X                  'r80_' // 'xx' // PATH80(LOOP)
223            LSM_RED = INDEX(HPATH,' ')
224            GOTO 900
225          ENDIF
226  220   CONTINUE
227C
228C       Dropthrough -> take latest.
229C
230        HPATH(1:) = YBASE(1:IBASELEN) //
231     X              'r80_' // 'xx' // PATH80(JPD80)
232        LSM_RED = INDEX(HPATH,' ')
233      ENDIF
234C
235C***************************************************************
236C     Section 9. Return.
237C***************************************************************
238C
239  900 CONTINUE
240C
241      RETURN
242      END
243