GCC Code Coverage Report

Directory: ./
File: rad/trans_inq.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 122 0.0%
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
378