GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/rrtm/trans_inq.F90 Lines: 0 122 0.0 %
Date: 2023-06-30 12:56:34 Branches: 0 398 0.0 %

Line Branch Exec Source
1
SUBROUTINE 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
99
USE PARKIND1  ,ONLY : JPIM     ,JPRB
100
101
!ifndef INTERFACE
102
103
USE TPM_GEN
104
USE TPM_DIM
105
USE TPM_DISTR
106
USE TPM_GEOMETRY
107
USE TPM_FIELDS
108
109
USE SET_RESOL_MOD
110
USE ABORT_TRANS_MOD
111
USE EQ_REGIONS_MOD
112
113
!endif INTERFACE
114
115
IMPLICIT NONE
116
117
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN)  :: KRESOL
118
119
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC
120
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC2
121
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC2G
122
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC2MX
123
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KNUMP
124
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOT
125
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOTG
126
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOTMX
127
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOTL(:,:)
128
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KFRSTLOFF
129
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRFLOFF
130
131
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMYMS(:)
132
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KASM0(0:)
133
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KUMPP(:)
134
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPOSSP(:)
135
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRMS(:)
136
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KALLMS(:)
137
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KDIM0G(0:)
138
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KFRSTLAT(:)
139
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KLSTLAT(:)
140
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRLAT(:)
141
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRFRSTLAT(:)
142
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRLSTLAT(:)
143
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSTA(:,:)
144
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KONL(:,:)
145
LOGICAL   ,OPTIONAL, INTENT(OUT) :: LDSPLITLAT(:)
146
147
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KULTPP(:)
148
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRLS(:)
149
150
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(OUT) :: PMU(:)
151
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(OUT) :: PGW(:)
152
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(OUT) :: PRPNM(:,:)
153
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KLEI3
154
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPOLEGL
155
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPMS(0:)
156
157
!ifndef INTERFACE
158
159
INTEGER(KIND=JPIM) :: IU1,IU2
160
!     ------------------------------------------------------------------
161
162
163
! Set current resolution
164
CALL SET_RESOL(KRESOL)
165
166
IF(PRESENT(KSPEC))     KSPEC     = D%NSPEC
167
IF(PRESENT(KSPEC2))    KSPEC2    = D%NSPEC2
168
IF(PRESENT(KSPEC2G))   KSPEC2G   = R%NSPEC2_G
169
IF(PRESENT(KSPEC2MX))  KSPEC2MX  = D%NSPEC2MX
170
IF(PRESENT(KNUMP))     KNUMP     = D%NUMP
171
IF(PRESENT(KGPTOT))    KGPTOT    = D%NGPTOT
172
IF(PRESENT(KGPTOTG))   KGPTOTG   = D%NGPTOTG
173
IF(PRESENT(KGPTOTMX))  KGPTOTMX  = D%NGPTOTMX
174
IF(PRESENT(KFRSTLOFF)) KFRSTLOFF = D%NFRSTLOFF
175
IF(PRESENT(KPTRFLOFF)) KPTRFLOFF = D%NPTRFLOFF
176
177
IF(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
185
ENDIF
186
187
IF(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
193
ENDIF
194
195
IF(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
201
ENDIF
202
203
IF(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
209
ENDIF
210
211
IF(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
217
ENDIF
218
219
IF(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
225
ENDIF
226
227
IF(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
233
ENDIF
234
235
IF(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
241
ENDIF
242
243
IF(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
249
ENDIF
250
251
IF(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
257
ENDIF
258
259
IF(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
265
ENDIF
266
267
IF(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
273
ENDIF
274
275
IF(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
281
ENDIF
282
283
IF(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
291
ENDIF
292
293
IF(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
301
ENDIF
302
303
IF(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
309
ENDIF
310
311
IF(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
317
ENDIF
318
319
IF(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
325
ENDIF
326
327
IF(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
333
ENDIF
334
335
IF(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
341
ENDIF
342
343
IF(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
353
ENDIF
354
IF(PRESENT(KLEI3)) THEN
355
  KLEI3=R%NLEI3
356
ENDIF
357
IF(PRESENT(KSPOLEGL)) THEN
358
  KSPOLEGL=D%NSPOLEGL
359
ENDIF
360
IF(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
366
ENDIF
367
!     ------------------------------------------------------------------
368
369
!endif INTERFACE
370
371
END SUBROUTINE TRANS_INQ
372
373
374
375
376
377