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 CREXSEL2(KSUBSET,KELEM,KTDLEN,KTDLST,KTDEXL,KTDEXP,
12     1                    CNAMES,CUNITS,KERR)
13C
14C**** *CREXSEL2*
15C
16C
17C
18C     PURPOSE.
19C     --------
20C          Returns list of Data Descriptors as in Section 1  of Crex
21C          message and total/requested list of elements.
22C
23C
24C**   INTERFACE.
25C     ----------
26C
27C          *CALL* *CREXSEL(KSUBSET,KELEM,KTDLEN,KTDLST,KTDEXL,KTDEXP,
28C                          CNAMES,CUNITS,KERR)*
29C
30C
31C        INPUT: *KSUBSET* -  Subset number
32C               *KELEM*   -
33C        OUTPUT:
34C               *KTDLEN*  -  number of data descriptors in section 1
35C               *KTDLST*  -  array containing data descriptors in section 1
36C               *KTDEXL*  -  number of entries in list of expanded data
37C                            descriptors
38C               *KTDEXP*  -  array containig expanded data descriptors
39C               *CNAMES*  -  ARRAY CONTAINING ELEMENT NAMES
40C               *CUNITS*  -  ARRAY CONTAINING ELEMENT UNITS
41C               *KERR*    -  returned error code
42C
43C
44C     METHOD.
45C     -------
46C
47C          NONE.
48C
49C     EXTERNALS.
50C     ----------
51C
52C          NONE.
53C
54C     REFERENCE.
55C     ----------
56C
57C          NONE.
58C
59C     AUTHOR.
60C     -------
61C
62C          MILAN DRAGOSAVAC    *ECMWF*       07/01/2004.
63C
64C
65C     MODIFICATIONS.
66C     --------------
67C
68C          NONE.
69C
70C
71      IMPLICIT LOGICAL(L,O,G), CHARACTER*8(C,H,Y)
72C
73C
74      PARAMETER(JSUP =   9,JSEC0=   3,JSEC1= 40,JSEC2= 64 ,JSEC3=    4,
75     1          JSEC4=   2,JELEM=40000,JSUBS=400,JCVAL=150 ,JBUFL=40000,
76     2          JBPW =  32,JTAB =3000,JCTAB=120,JCTST=1800,JCTEXT= 200,
77     3          JWORK=360000,JKEY=46)
78C
79C
80      COMMON /CREXEL/ NCREXTDLEN,NCREXTDLST(JELEM),NCREXTDEXL,
81     1                NCREXTDEXP(JELEM)
82C
83C             NCREXTDLEN - number of Data descriptors in section 1
84C             NCREXTDLST - list of Data descriptors
85C             NCREXTDEXL - number of expanded Data Descriptors
86C             NCREXTDEXP - list of expanded Data descriptors
87C
88C
89      COMMON /CREXOFF/ NSIZEG(JELEM),NCREXWTRG(JWORK),
90     1                 NBP,NSUBSET,OMULTI
91C
92      DIMENSION  KTDLST(*),KTDEXP(*)
93C
94      CHARACTER*64 CNAMES(*)
95      CHARACTER*24 CUNITS(*)
96C
97C     -----------------------------------------------------------------
98
99C*          1.  PUT LIST OF ELEMENTS FROM COMMON BLOCK
100C               --------------------------------------
101C               TO REQUESTED ARRAYS.
102C               --------------------
103 100  CONTINUE
104C
105      KERR=0
106C
107      KTDLEN=NCREXTDLEN
108C
109      DO 101 I=1,NCREXTDLEN
110      KTDLST(I)=NCREXTDLST(I)
111 101  CONTINUE
112C
113      NTDEXL=NSIZEG(KSUBSET)
114      KTDEXL=NTDEXL
115      IJ=(KSUBSET-1)*KELEM
116
117      DO 102 I=1,KTDEXL
118      IIJ=I+IJ
119      KTDEXP(I)=NCREXWTRG(IIJ)
120      CALL CREX_GET_NAME_UNIT(KTDEXP(I),CNAMES(I),CUNITS(I))
121 102  CONTINUE
122C
123      RETURN
124      END
125