source: LMDZ6/branches/blowing_snow/libf/phylmd/rrtm/trans_inq.F90

Last change on this file was 1990, checked in by Laurent Fairhead, 11 years ago

Corrections à la version r1989 pour permettre la compilation avec RRTM
Inclusion de la licence CeCILL_V2 pour RRTM

Changes to revision r1989 to enable RRTM code compilation
RRTM part put under CeCILL_V2 licence
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 11.6 KB
Line 
1SUBROUTINE TRANS_INQ(KRESOL,KSPEC,KSPEC2,KSPEC2G,KSPEC2MX,KNUMP,&
2                    &KGPTOT,KGPTOTG,KGPTOTMX,KGPTOTL,&
3                    &KMYMS,KASM0,KUMPP,KPOSSP,KPTRMS,KALLMS,KDIM0G,&
4                    &KFRSTLAT,KLSTLAT,KFRSTLOFF,KPTRLAT,&
5                    &KPTRFRSTLAT,KPTRLSTLAT,KPTRFLOFF,KSTA,KONL,&
6                    &KULTPP,KPTRLS,&
7                    &LDSPLITLAT,&
8                    &PMU,PGW,PRPNM,KLEI3,KSPOLEGL,KPMS)
9
10!**** *TRANS_INQ* - Extract information from the transform package
11
12!     Purpose.
13!     --------
14!     Interface routine for extracting information from the T.P.
15
16!**   Interface.
17!     ----------
18!     CALL TRANS_INQ(...)
19!     Explicit arguments : All arguments are optional.
20!     --------------------
21!     KRESOL   - resolution tag for which info is required ,default is the
22!                first defined resulution (input)
23
24!                   SPECTRAL SPACE
25!     KSPEC    - number of complex spectral coefficients on this PE
26!     KSPEC2   - 2*KSPEC
27!     KSPEC2G  - global KSPEC2
28!     KSPEC2MX - maximun KSPEC2 among all PEs
29!     KNUMP    - Number of spectral waves handled by this PE
30!     KGPTOT   - Total number of grid columns on this PE
31!     KGPTOTG  - Total number of grid columns on the Globe
32!     KGPTOTMX - Maximum number of grid columns on any of the PEs
33!     KGPTOTL  - Number of grid columns one each PE (dimension N_REGIONS_NS:N_REGIONS_EW)
34!     KMYMS    - This PEs spectral zonal wavenumbers
35!     KASM0    - Address in a spectral array of (m, n=m)
36!     KUMPP    - No. of wave numbers each wave set is responsible for
37!     KPOSSP   - Defines partitioning of global spectral fields among PEs
38!     KPTRMS   - Pointer to the first wave number of a given a-set
39!     KALLMS   - Wave numbers for all wave-set concatenated together
40!                to give all wave numbers in wave-set order
41!     KDIM0G   - Defines partitioning of global spectral fields among PEs
42
43!                 GRIDPOINT SPACE                 
44!     KFRSTLAT    - First latitude of each a-set in grid-point space
45!     KLSTTLAT    - Last latitude of each a-set in grid-point space
46!     KFRSTLOFF   - Offset for first lat of own a-set in grid-point space
47!     KPTRLAT     - Pointer to the start of each latitude
48!     KPTRFRSTLAT - Pointer to the first latitude of each a-set in
49!                   NSTA and NONL arrays
50!     KPTRLSTLAT  - Pointer to the last latitude of each a-set in
51!                   NSTA and NONL arrays
52!     KPTRFLOFF   - Offset for pointer to the first latitude of own a-set
53!                   NSTA and NONL arrays, i.e. nptrfrstlat(myseta)-1
54!     KSTA        - Position of first grid column for the latitudes on a
55!                   processor. The information is available for all processors.
56!                   The b-sets are distinguished by the last dimension of
57!                   nsta().The latitude band for each a-set is addressed by
58!                   nptrfrstlat(jaset),nptrlstlat(jaset), and
59!                   nptrfloff=nptrfrstlat(myseta) on this processors a-set.
60!                   Each split latitude has two entries in nsta(,:) which
61!                   necessitates the rather complex addressing of nsta(,:)
62!                   and the overdimensioning of nsta by N_REGIONS_NS.
63!     KONL        - Number of grid columns for the latitudes on a processor.
64!                   Similar to nsta() in data structure.
65!     LDSPLITLAT  - TRUE if latitude is split in grid point space over
66!                   two a-sets
67
68!                FOURIER SPACE
69!     KULTPP   - number of latitudes for which each a-set is calculating
70!                the FFT's.
71!     KPTRLS   - pointer to first global latitude of each a-set for which
72!                it performs the Fourier calculations
73
74!                 LEGENDRE
75!     PMU      - sin(Gaussian latitudes)
76!     PGW      - Gaussian weights
77!     PRPNM    - Legendre polynomials
78!     KLEI3    - First dimension of Legendre polynomials
79!     KSPOLEGL - Second dimension of Legendre polynomials
80!     KPMS     - Adress for legendre polynomial for given M (NSMAX)
81
82!     Method.
83!     -------
84
85!     Externals.  SET_RESOL - set resolution
86!     ---------- 
87
88!     Author.
89!     -------
90!        Mats Hamrud *ECMWF*
91
92!     Modifications.
93!     --------------
94!        Original : 00-03-03
95!        M. Hortal : 2001-03-05 Dimensions of the Legendre polynomials
96
97!     ------------------------------------------------------------------
98
99USE PARKIND1  ,ONLY : JPIM     ,JPRB
100
101!ifndef INTERFACE
102
103USE TPM_GEN
104USE TPM_DIM
105USE TPM_DISTR
106USE TPM_GEOMETRY
107USE TPM_FIELDS
108
109USE SET_RESOL_MOD
110USE ABORT_TRANS_MOD
111USE EQ_REGIONS_MOD
112
113!endif INTERFACE
114
115IMPLICIT NONE
116
117INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN)  :: KRESOL
118
119INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC
120INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC2
121INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC2G
122INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC2MX
123INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KNUMP
124INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOT
125INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOTG
126INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOTMX
127INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOTL(:,:)
128INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KFRSTLOFF
129INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRFLOFF
130
131INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMYMS(:)
132INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KASM0(0:)
133INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KUMPP(:)
134INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPOSSP(:)
135INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRMS(:)
136INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KALLMS(:)
137INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KDIM0G(0:)
138INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KFRSTLAT(:)
139INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KLSTLAT(:)
140INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRLAT(:)
141INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRFRSTLAT(:)
142INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRLSTLAT(:)
143INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSTA(:,:)
144INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KONL(:,:)
145LOGICAL   ,OPTIONAL, INTENT(OUT) :: LDSPLITLAT(:)
146
147INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KULTPP(:)
148INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRLS(:)
149
150REAL(KIND=JPRB)    ,OPTIONAL, INTENT(OUT) :: PMU(:)
151REAL(KIND=JPRB)    ,OPTIONAL, INTENT(OUT) :: PGW(:)
152REAL(KIND=JPRB)    ,OPTIONAL, INTENT(OUT) :: PRPNM(:,:)
153INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KLEI3
154INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPOLEGL
155INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPMS(0:)
156
157!ifndef INTERFACE
158
159INTEGER(KIND=JPIM) :: IU1,IU2
160!     ------------------------------------------------------------------
161
162
163! Set current resolution
164CALL SET_RESOL(KRESOL)
165
166IF(PRESENT(KSPEC))     KSPEC     = D%NSPEC
167IF(PRESENT(KSPEC2))    KSPEC2    = D%NSPEC2
168IF(PRESENT(KSPEC2G))   KSPEC2G   = R%NSPEC2_G
169IF(PRESENT(KSPEC2MX))  KSPEC2MX  = D%NSPEC2MX
170IF(PRESENT(KNUMP))     KNUMP     = D%NUMP
171IF(PRESENT(KGPTOT))    KGPTOT    = D%NGPTOT
172IF(PRESENT(KGPTOTG))   KGPTOTG   = D%NGPTOTG
173IF(PRESENT(KGPTOTMX))  KGPTOTMX  = D%NGPTOTMX
174IF(PRESENT(KFRSTLOFF)) KFRSTLOFF = D%NFRSTLOFF
175IF(PRESENT(KPTRFLOFF)) KPTRFLOFF = D%NPTRFLOFF
176
177IF(PRESENT(KGPTOTL)) THEN
178  IF(UBOUND(KGPTOTL,1) < N_REGIONS_NS) THEN
179    CALL ABORT_TRANS('TRANS_INQ: KGPTOTL DIM 1 TOO SMALL')
180  ELSEIF(UBOUND(KGPTOTL,2) <  N_REGIONS_EW) THEN
181    CALL ABORT_TRANS('TRANS_INQ: KGPTOTL DIM 2 TOO SMALL')
182  ELSE
183    KGPTOTL(1:N_REGIONS_NS,1:N_REGIONS_EW) = D%NGPTOTL(:,:)
184  ENDIF
185ENDIF
186
187IF(PRESENT(KMYMS)) THEN
188  IF(UBOUND(KMYMS,1) < D%NUMP) THEN
189    CALL ABORT_TRANS('TRANS_INQ: KMYMS TOO SMALL')
190  ELSE
191    KMYMS(1:D%NUMP) = D%MYMS(:)
192  ENDIF
193ENDIF
194
195IF(PRESENT(KASM0)) THEN
196  IF(UBOUND(KASM0,1) < R%NSMAX) THEN
197    CALL ABORT_TRANS('TRANS_INQ: KASM0 TOO SMALL')
198  ELSE
199    KASM0(0:R%NSMAX) = D%NASM0(:)
200  ENDIF
201ENDIF
202
203IF(PRESENT(KUMPP)) THEN
204  IF(UBOUND(KUMPP,1) < NPRTRW) THEN
205    CALL ABORT_TRANS('TRANS_INQ: KUMPP TOO SMALL')
206  ELSE
207    KUMPP(1:NPRTRW) = D%NUMPP(:)
208  ENDIF
209ENDIF
210
211IF(PRESENT(KPOSSP)) THEN
212  IF(UBOUND(KPOSSP,1) < NPRTRW+1) THEN
213    CALL ABORT_TRANS('TRANS_INQ: KPOSSP TOO SMALL')
214  ELSE
215    KPOSSP(1:NPRTRW+1) = D%NPOSSP(:)
216  ENDIF
217ENDIF
218
219IF(PRESENT(KPTRMS)) THEN
220  IF(UBOUND(KPTRMS,1) < NPRTRW) THEN
221    CALL ABORT_TRANS('TRANS_INQ: KPTRMS TOO SMALL')
222  ELSE
223    KPTRMS(1:NPRTRW) = D%NPTRMS(:)
224  ENDIF
225ENDIF
226
227IF(PRESENT(KALLMS)) THEN
228  IF(UBOUND(KALLMS,1) < R%NSMAX+1) THEN
229    CALL ABORT_TRANS('TRANS_INQ: KALLMS TOO SMALL')
230  ELSE
231    KALLMS(1:R%NSMAX+1) = D%NALLMS(:)
232  ENDIF
233ENDIF
234
235IF(PRESENT(KDIM0G)) THEN
236  IF(UBOUND(KDIM0G,1) < R%NSMAX) THEN
237    CALL ABORT_TRANS('TRANS_INQ: KDIM0G TOO SMALL')
238  ELSE
239    KDIM0G(0:R%NSMAX) = D%NDIM0G(0:R%NSMAX)
240  ENDIF
241ENDIF
242
243IF(PRESENT(KFRSTLAT)) THEN
244  IF(UBOUND(KFRSTLAT,1) < N_REGIONS_NS) THEN
245    CALL ABORT_TRANS('TRANS_INQ: KFRSTLAT TOO SMALL')
246  ELSE
247    KFRSTLAT(1:N_REGIONS_NS) = D%NFRSTLAT(:)
248  ENDIF
249ENDIF
250
251IF(PRESENT(KLSTLAT)) THEN
252  IF(UBOUND(KLSTLAT,1) < N_REGIONS_NS) THEN
253    CALL ABORT_TRANS('TRANS_INQ: KLSTLAT TOO SMALL')
254  ELSE
255    KLSTLAT(1:N_REGIONS_NS) = D%NLSTLAT(:)
256  ENDIF
257ENDIF
258
259IF(PRESENT(KPTRLAT)) THEN
260  IF(UBOUND(KPTRLAT,1) < R%NDGL) THEN
261    CALL ABORT_TRANS('TRANS_INQ: KPTRLAT TOO SMALL')
262  ELSE
263    KPTRLAT(1:R%NDGL) = D%NPTRLAT(:)
264  ENDIF
265ENDIF
266
267IF(PRESENT(KPTRFRSTLAT)) THEN
268  IF(UBOUND(KPTRFRSTLAT,1) < N_REGIONS_NS) THEN
269    CALL ABORT_TRANS('TRANS_INQ: KPTRFRSTLAT TOO SMALL')
270  ELSE
271    KPTRFRSTLAT(1:N_REGIONS_NS) = D%NPTRFRSTLAT(:)
272  ENDIF
273ENDIF
274
275IF(PRESENT(KPTRLSTLAT)) THEN
276  IF(UBOUND(KPTRLSTLAT,1) < N_REGIONS_NS) THEN
277    CALL ABORT_TRANS('TRANS_INQ: KPTRLSTLAT TOO SMALL')
278  ELSE
279    KPTRLSTLAT(1:N_REGIONS_NS) = D%NPTRLSTLAT(:)
280  ENDIF
281ENDIF
282
283IF(PRESENT(KSTA)) THEN
284  IF(UBOUND(KSTA,1) < R%NDGL+N_REGIONS_NS-1) THEN
285    CALL ABORT_TRANS('TRANS_INQ: KSTA DIM 1 TOO SMALL')
286  ELSEIF(UBOUND(KSTA,2) < N_REGIONS_EW) THEN
287    CALL ABORT_TRANS('TRANS_INQ: KSTA DIM 2 TOO SMALL')
288  ELSE
289    KSTA(1:R%NDGL+N_REGIONS_NS-1,1:N_REGIONS_EW) = D%NSTA(:,:)
290  ENDIF
291ENDIF
292
293IF(PRESENT(KONL)) THEN
294  IF(UBOUND(KONL,1) < R%NDGL+N_REGIONS_NS-1) THEN
295    CALL ABORT_TRANS('TRANS_INQ: KONL DIM 1 TOO SMALL')
296  ELSEIF(UBOUND(KONL,2) < N_REGIONS_EW) THEN
297    CALL ABORT_TRANS('TRANS_INQ: KONL DIM 2 TOO SMALL')
298  ELSE
299    KONL(1:R%NDGL+N_REGIONS_NS-1,1:N_REGIONS_EW) = D%NONL(:,:)
300  ENDIF
301ENDIF
302
303IF(PRESENT(LDSPLITLAT)) THEN
304  IF(UBOUND(LDSPLITLAT,1) < R%NDGL) THEN
305    CALL ABORT_TRANS('TRANS_INQ: LDSPLITLAT TOO SMALL')
306  ELSE
307    LDSPLITLAT(1:R%NDGL) = D%LSPLITLAT(:)
308  ENDIF
309ENDIF
310
311IF(PRESENT(KULTPP)) THEN
312  IF(UBOUND(KULTPP,1) < NPRTRNS) THEN
313    CALL ABORT_TRANS('TRANS_INQ: KULTPP TOO SMALL')
314  ELSE
315    KULTPP(1:NPRTRNS) = D%NULTPP(:)
316  ENDIF
317ENDIF
318
319IF(PRESENT(KPTRLS)) THEN
320  IF(UBOUND(KPTRLS,1) < NPRTRNS) THEN
321    CALL ABORT_TRANS('TRANS_INQ: KPTRLS TOO SMALL')
322  ELSE
323    KPTRLS(1:NPRTRNS) = D%NPTRLS(:)
324  ENDIF
325ENDIF
326
327IF(PRESENT(PMU)) THEN
328  IF(UBOUND(PMU,1) < R%NDGL) THEN
329    CALL ABORT_TRANS('TRANS_INQ: PMU TOO SMALL')
330  ELSE
331    PMU(1:R%NDGL) = F%RMU
332  ENDIF
333ENDIF
334
335IF(PRESENT(PGW)) THEN
336  IF(UBOUND(PGW,1) < R%NDGL) THEN
337    CALL ABORT_TRANS('TRANS_INQ: PGW TOO SMALL')
338  ELSE
339    PGW(1:R%NDGL) = F%RW
340  ENDIF
341ENDIF
342
343IF(PRESENT(PRPNM)) THEN
344  IU1 = UBOUND(PRPNM,1)
345  IU2 = UBOUND(PRPNM,2)
346  IF(IU1 < R%NDGNH) THEN
347    CALL ABORT_TRANS('TRANS_INQ:FIRST DIM. OF PRNM TOO SMALL')
348  ELSE
349    IU1 = MIN(IU1,R%NLEI3)
350    IU2 = MIN(IU2,D%NSPOLEGL)
351    PRPNM(1:IU1,1:IU2) = F%RPNM(1:IU1,1:IU2)
352  ENDIF
353ENDIF
354IF(PRESENT(KLEI3)) THEN
355  KLEI3=R%NLEI3
356ENDIF
357IF(PRESENT(KSPOLEGL)) THEN
358  KSPOLEGL=D%NSPOLEGL
359ENDIF
360IF(PRESENT(KPMS)) THEN
361  IF(UBOUND(KPMS,1) < R%NSMAX) THEN
362    CALL ABORT_TRANS('TRANS_INQ: KPMS TOO SMALL')
363  ELSE
364    KPMS(0:R%NSMAX) = D%NPMS(0:R%NSMAX)
365  ENDIF
366ENDIF
367!     ------------------------------------------------------------------
368
369!endif INTERFACE
370
371END SUBROUTINE TRANS_INQ
372
373
374
375
376
377
Note: See TracBrowser for help on using the repository browser.