1 | !*********************************************************************** |
---|
2 | !* Copyright 2012,2013 * |
---|
3 | !* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine, * |
---|
4 | !* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,* |
---|
5 | !* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso, * |
---|
6 | !* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann, * |
---|
7 | !* * |
---|
8 | !* This file is part of FLEXPART WRF * |
---|
9 | !* * |
---|
10 | !* FLEXPART is free software: you can redistribute it and/or modify * |
---|
11 | !* it under the terms of the GNU General Public License as published by* |
---|
12 | !* the Free Software Foundation, either version 3 of the License, or * |
---|
13 | !* (at your option) any later version. * |
---|
14 | !* * |
---|
15 | !* FLEXPART is distributed in the hope that it will be useful, * |
---|
16 | !* but WITHOUT ANY WARRANTY; without even the implied warranty of * |
---|
17 | !* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * |
---|
18 | !* GNU General Public License for more details. * |
---|
19 | !* * |
---|
20 | !* You should have received a copy of the GNU General Public License * |
---|
21 | !* along with FLEXPART. If not, see <http://www.gnu.org/licenses/>. * |
---|
22 | !*********************************************************************** |
---|
23 | |
---|
24 | !********************************************************************** |
---|
25 | ! FLEXPART SOURCE FILE READ_NCWRFOUT - CONTAINS * |
---|
26 | ! * |
---|
27 | ! SUBROUTINE READ_NCWRFOUT_GRIDINFO * |
---|
28 | ! SUBROUTINE READ_NCWRFOUT_1REALFIELD * |
---|
29 | ! SUBROUTINE READ_NCWRFOUT_1DATETIME * |
---|
30 | ! * |
---|
31 | !********************************************************************** |
---|
32 | ! * |
---|
33 | ! AUTHOR: R. Easter & J. Fast, PNNL * |
---|
34 | ! DATE: 2005-autumn-?? * |
---|
35 | ! LAST UPDATE: same * |
---|
36 | ! * |
---|
37 | !********************************************************************** |
---|
38 | ! * |
---|
39 | ! DESCRIPTION: * |
---|
40 | ! * |
---|
41 | ! These routines read the netcdf wrf output files. * |
---|
42 | ! * |
---|
43 | ! 13 JUNE 2007, add more arguments-- ext_scalar,pbl_physcis |
---|
44 | !********************************************************************** |
---|
45 | |
---|
46 | |
---|
47 | !----------------------------------------------------------------------- |
---|
48 | subroutine read_ncwrfout_gridinfo( ierr, idiagaa, fnamenc, & |
---|
49 | n_west_east, n_south_north, n_bottom_top, & |
---|
50 | dx_met, dy_met, & |
---|
51 | m_grid_id, m_parent_grid_id, m_parent_grid_ratio, & |
---|
52 | i_parent_start, j_parent_start, & |
---|
53 | map_proj_id, map_stdlon, map_truelat1, map_truelat2, & |
---|
54 | ext_scalar,pbl_physics,microphysics) |
---|
55 | ! |
---|
56 | ! reads grid definition information from a netcdf wrf output file |
---|
57 | ! |
---|
58 | ! arguments |
---|
59 | ! ierr - output - if non-zero, an error occurred |
---|
60 | ! while opening or reading from the file |
---|
61 | ! idiagaa - input - if positive, testing diagnostics are printed |
---|
62 | ! fnamenc - input - path+filename of the wrf output file |
---|
63 | ! n_west_east - output - east_west dimension of the "T-grid" |
---|
64 | ! n_south_north - output - south_north dimension of the "T-grid" |
---|
65 | ! n_bottom_top - output - bottom_top dimension of the "T-grid" |
---|
66 | ! dx_met, dy_met - output - horizontal grid spacing (m) |
---|
67 | ! m_grid_id - output - grid id number |
---|
68 | ! m_parent_grid_id - output - grid id number of parent grid |
---|
69 | ! m_parent_grid_ratio - output - ratio of parent grid dxy to current grid dxy |
---|
70 | ! i_parent_start, j_parent_start - output - location of lower left corner |
---|
71 | ! of current grid relative to the parent grid. |
---|
72 | ! (if there is no parent grid, then the above 4 "...parent..." variables |
---|
73 | ! area set to -987.) |
---|
74 | ! map_proj_id - WRF map projection id (2=polar stereographic) |
---|
75 | ! map_stdlon - map projection standard longitude (deg) |
---|
76 | ! map_truelat1, truelat2 - map projection true latitudes (deg) |
---|
77 | ! |
---|
78 | ! ext_scalar -- dimension of ex_scalar |
---|
79 | ! pbl_physics -- type of PBL scheme |
---|
80 | ! microphysics -- micorphysice scheme used |
---|
81 | |
---|
82 | include 'netcdf.inc' |
---|
83 | ! use netcdf |
---|
84 | ! implicit none |
---|
85 | |
---|
86 | ! arguments |
---|
87 | integer :: ierr, idiagaa, & |
---|
88 | n_west_east, n_south_north, n_bottom_top, & |
---|
89 | m_grid_id, m_parent_grid_id, m_parent_grid_ratio, & |
---|
90 | i_parent_start, j_parent_start, map_proj_id, & |
---|
91 | ext_scalar,pbl_physics,microphysics |
---|
92 | |
---|
93 | real :: dx_met, dy_met, map_stdlon, map_truelat1, map_truelat2 |
---|
94 | |
---|
95 | character*(*) fnamenc |
---|
96 | |
---|
97 | ! local variables |
---|
98 | integer,parameter :: maxdim=20 |
---|
99 | integer,parameter :: ibadaa= -987 |
---|
100 | integer,parameter :: xbadaa= -987 |
---|
101 | |
---|
102 | integer :: i, iatt, idimid_unlim, idum, iret, ivtype |
---|
103 | integer :: l, lenatt, lendim(maxdim) |
---|
104 | integer :: natts_tot, ncid, ndims_tot, nvars_tot |
---|
105 | integer :: n_west_east_stag, n_south_north_stag, n_bottom_top_stag |
---|
106 | |
---|
107 | real :: duma |
---|
108 | real, allocatable, dimension(:) :: duma_alloc |
---|
109 | |
---|
110 | character(len=80) :: dimname(maxdim) |
---|
111 | character(len=80) :: attname |
---|
112 | character(len=1000) :: dumch1000 |
---|
113 | |
---|
114 | ! externals |
---|
115 | ! integer nf_close |
---|
116 | ! integer nf_inq |
---|
117 | ! integer nf_inq_dim |
---|
118 | ! integer nf_open |
---|
119 | |
---|
120 | |
---|
121 | |
---|
122 | ! initialize with "missing values" |
---|
123 | n_west_east = ibadaa |
---|
124 | n_south_north = ibadaa |
---|
125 | n_bottom_top = ibadaa |
---|
126 | dx_met = xbadaa |
---|
127 | dy_met = xbadaa |
---|
128 | m_grid_id = ibadaa |
---|
129 | m_parent_grid_id = ibadaa |
---|
130 | m_parent_grid_ratio = ibadaa |
---|
131 | i_parent_start = ibadaa |
---|
132 | j_parent_start = ibadaa |
---|
133 | ext_scalar = ibadaa |
---|
134 | pbl_physics = ibadaa |
---|
135 | microphysics = ibadaa |
---|
136 | ! |
---|
137 | ! open the netcdf file |
---|
138 | ! |
---|
139 | ncid = 10 |
---|
140 | !C write(*,*)'xxx inside read_ncwrfout.f fnamenc=',fnamenc |
---|
141 | !C write(*,*)'mp_physics=',microphysics |
---|
142 | |
---|
143 | ! print*,'filename ',fnamenc |
---|
144 | iret = nf_open( fnamenc, NF_NOWRITE, ncid ) |
---|
145 | if (iret .ne. nf_noerr) then |
---|
146 | write(*,9100) 'error doing open 123',fnamenc |
---|
147 | ! print*, NF_NOWRITE, ncid,iret |
---|
148 | ierr = -1 |
---|
149 | return |
---|
150 | end if |
---|
151 | |
---|
152 | 9100 format( / '*** read_ncwrfout_gridinfo -- ', a / & |
---|
153 | 'file = ', a ) |
---|
154 | 9110 format( / '*** read_ncwrfout_gridinfo -- ', a, 1x, i8 / & |
---|
155 | 'file = ', a ) |
---|
156 | 9120 format( / '*** read_ncwrfout_gridinfo -- ', a, 2(1x,i8) / & |
---|
157 | 'file = ', a ) |
---|
158 | |
---|
159 | 90030 format( a, 2i6, 2(2x,a) ) |
---|
160 | |
---|
161 | ! |
---|
162 | ! get information on dimensions |
---|
163 | ! |
---|
164 | iret = nf_inq( ncid, & |
---|
165 | ndims_tot, nvars_tot, natts_tot, idimid_unlim ) |
---|
166 | if (iret .ne. nf_noerr) then |
---|
167 | write(*,9100) 'error inquiring dimensions', fnamenc |
---|
168 | ierr = -2 |
---|
169 | return |
---|
170 | end if |
---|
171 | |
---|
172 | n_west_east_stag = ibadaa |
---|
173 | n_south_north_stag = ibadaa |
---|
174 | n_bottom_top_stag = ibadaa |
---|
175 | |
---|
176 | do i = 1, min(ndims_tot,maxdim) |
---|
177 | iret = nf_inq_dim( ncid, i, dimname(i), lendim(i) ) |
---|
178 | if (iret .ne. nf_noerr) then |
---|
179 | write(*,9110) 'error inquiring dimensions for dim#', i, fnamenc |
---|
180 | ierr = -2 |
---|
181 | return |
---|
182 | end if |
---|
183 | end do |
---|
184 | |
---|
185 | do i = 1, min(ndims_tot,maxdim) |
---|
186 | if (dimname(i) .eq. 'west_east') & |
---|
187 | n_west_east = lendim(i) |
---|
188 | if (dimname(i) .eq. 'south_north') & |
---|
189 | n_south_north = lendim(i) |
---|
190 | if (dimname(i) .eq. 'bottom_top') & |
---|
191 | n_bottom_top = lendim(i) |
---|
192 | if (dimname(i) .eq. 'west_east_stag') & |
---|
193 | n_west_east_stag = lendim(i) |
---|
194 | if (dimname(i) .eq. 'south_north_stag') & |
---|
195 | n_south_north_stag = lendim(i) |
---|
196 | if (dimname(i) .eq. 'bottom_top_stag') & |
---|
197 | n_bottom_top_stag = lendim(i) |
---|
198 | if (dimname(i) .eq. 'ext_scalar') & |
---|
199 | ext_scalar = lendim(i) |
---|
200 | |
---|
201 | end do |
---|
202 | |
---|
203 | if (idiagaa .gt. 0) then |
---|
204 | write(*,9100) 'diagnostics', fnamenc |
---|
205 | do i = 1, min(ndims_tot,maxdim) |
---|
206 | write(*,90030) 'dim #, len, name =', & |
---|
207 | i, lendim(i), dimname(i) |
---|
208 | end do |
---|
209 | end if |
---|
210 | |
---|
211 | if ((n_west_east .le. 0) .or. & |
---|
212 | (n_west_east+1 .ne. n_west_east_stag)) then |
---|
213 | write(*,9120) 'bad n_west_east, n_west_east_stag = ', & |
---|
214 | n_west_east, n_west_east_stag, fnamenc |
---|
215 | ierr = -3 |
---|
216 | return |
---|
217 | end if |
---|
218 | |
---|
219 | if ((n_south_north .le. 0) .or. & |
---|
220 | (n_south_north+1 .ne. n_south_north_stag)) then |
---|
221 | write(*,9120) 'bad n_south_north, n_south_north_stag = ', & |
---|
222 | n_south_north, n_south_north_stag, fnamenc |
---|
223 | ierr = -3 |
---|
224 | return |
---|
225 | end if |
---|
226 | |
---|
227 | if ((n_bottom_top .le. 0) .or. & |
---|
228 | (n_bottom_top+1 .ne. n_bottom_top_stag)) then |
---|
229 | write(*,9120) 'bad n_bottom_top, n_bottom_top_stag = ', & |
---|
230 | n_bottom_top, n_bottom_top_stag, fnamenc |
---|
231 | ierr = -3 |
---|
232 | return |
---|
233 | end if |
---|
234 | |
---|
235 | ! |
---|
236 | ! get information on global attributes |
---|
237 | ! |
---|
238 | |
---|
239 | ! first just do diagnostics |
---|
240 | if (idiagaa .gt. 0) then |
---|
241 | write(*,*) |
---|
242 | write(*,*) 'attribute #, name, type, value' |
---|
243 | end if |
---|
244 | do iatt = 1, natts_tot |
---|
245 | iret = nf_inq_attname( ncid, nf_global, iatt, attname) |
---|
246 | if (iret .ne. nf_noerr) goto 3600 |
---|
247 | iret = nf_inq_att( ncid, nf_global, attname, ivtype, lenatt ) |
---|
248 | if (iret .ne. nf_noerr) goto 3600 |
---|
249 | if (ivtype .eq. 2) then |
---|
250 | iret = nf_get_att_text( ncid, nf_global, attname, dumch1000 ) |
---|
251 | if (iret .ne. nf_noerr) goto 3600 |
---|
252 | i = max(1,min(1000,lenatt)) |
---|
253 | if (idiagaa .gt. 0) write(*,91010) & |
---|
254 | iatt, attname(1:40), ivtype, lenatt, dumch1000(1:i) |
---|
255 | else if (ivtype .eq. 4) then |
---|
256 | iret = nf_get_att_int( ncid, nf_global, attname, idum ) |
---|
257 | if (iret .ne. nf_noerr) goto 3600 |
---|
258 | if (idiagaa .gt. 0) write(*,91020) & |
---|
259 | iatt, attname(1:40), ivtype, lenatt, idum |
---|
260 | else if ((ivtype .eq. 5) .and. (lenatt .eq. 1)) then |
---|
261 | iret = nf_get_att_real( ncid, nf_global, attname, duma ) |
---|
262 | if (iret .ne. nf_noerr) goto 3600 |
---|
263 | if (idiagaa .gt. 0) write(*,91030) & |
---|
264 | iatt, attname(1:40), ivtype, lenatt, duma |
---|
265 | else if ((ivtype .eq. 5) .and. (lenatt .gt. 1)) then |
---|
266 | allocate( duma_alloc(lenatt) ) |
---|
267 | iret = nf_get_att_real( ncid, nf_global, attname, duma_alloc ) |
---|
268 | if (iret .ne. nf_noerr) goto 3600 |
---|
269 | if (idiagaa .gt. 0) then |
---|
270 | write(*,91010) iatt, attname(1:40), ivtype, lenatt |
---|
271 | write(*,91040) (duma_alloc(i), i=1,lenatt) |
---|
272 | end if |
---|
273 | deallocate( duma_alloc ) |
---|
274 | else |
---|
275 | if (idiagaa .gt. 0) write(*,'(i4,1x,a,2(1x,i6))') & |
---|
276 | iatt, attname(1:40), ivtype, lenatt |
---|
277 | goto 3400 |
---|
278 | endif |
---|
279 | |
---|
280 | if (attname .eq. 'GRID_ID') then |
---|
281 | m_grid_id = idum |
---|
282 | else if (attname .eq. 'PARENT_ID') then |
---|
283 | m_parent_grid_id = idum |
---|
284 | else if (attname .eq. 'PARENT_GRID_RATIO') then |
---|
285 | m_parent_grid_ratio = idum |
---|
286 | else if (attname .eq. 'I_PARENT_START') then |
---|
287 | i_parent_start = idum |
---|
288 | else if (attname .eq. 'J_PARENT_START') then |
---|
289 | j_parent_start = idum |
---|
290 | else if (attname .eq. 'DX') then |
---|
291 | dx_met = duma |
---|
292 | else if (attname .eq. 'DY') then |
---|
293 | dy_met = duma |
---|
294 | else if (attname .eq. 'MAP_PROJ') then |
---|
295 | map_proj_id = idum |
---|
296 | else if (attname .eq. 'STAND_LON') then |
---|
297 | map_stdlon = duma |
---|
298 | else if (attname .eq. 'TRUELAT1') then |
---|
299 | map_truelat1 = duma |
---|
300 | else if (attname .eq. 'TRUELAT2') then |
---|
301 | map_truelat2 = duma |
---|
302 | else if (attname .eq. 'BL_PBL_PHYSICS') then |
---|
303 | pbl_physics = idum |
---|
304 | else if (attname .eq. 'MP_PHYSICS') then |
---|
305 | microphysics = idum |
---|
306 | end if |
---|
307 | enddo |
---|
308 | 3400 continue |
---|
309 | 91010 format( i4, 1x, a, 2(1x,i6), 1x, a ) |
---|
310 | 91020 format( i4, 1x, a, 2(1x,i6), 1x, i10 ) |
---|
311 | 91030 format( i4, 1x, a, 2(1x,i6), 1x, 1pe12.4 ) |
---|
312 | 91040 format(( 12x, 5(1pe12.4) )) |
---|
313 | |
---|
314 | goto 3900 |
---|
315 | |
---|
316 | 3600 write(*,9110) 'error inquiring attribute', iatt, fnamenc |
---|
317 | stop |
---|
318 | |
---|
319 | 3900 continue |
---|
320 | |
---|
321 | !C write(*,*)'mp_physics=',microphysics,pbl_physics |
---|
322 | |
---|
323 | ! |
---|
324 | ! close and return |
---|
325 | ! |
---|
326 | iret = nf_close( ncid ) |
---|
327 | ierr = 0 |
---|
328 | |
---|
329 | return |
---|
330 | end subroutine read_ncwrfout_gridinfo |
---|
331 | |
---|
332 | |
---|
333 | |
---|
334 | !----------------------------------------------------------------------- |
---|
335 | subroutine read_ncwrfout_1datetime( ierr, fnamenc, & |
---|
336 | itime, jyyyymmdd, jhhmmss ) |
---|
337 | ! |
---|
338 | ! a wrf output file may contain data at multiple time. This routine returns |
---|
339 | ! the date & time of the "itime" data group in the file. |
---|
340 | ! |
---|
341 | ! arguments |
---|
342 | ! ierr - output - if non-zero, an error occurred |
---|
343 | ! while opening or reading from the file, |
---|
344 | ! or itime < 0, or itime > number of times in the file. |
---|
345 | ! fnamenc - input - path+filename of the wrf output file |
---|
346 | ! itime - input - specifies which data/time to return. |
---|
347 | ! 1 for first, 2 for second, ... |
---|
348 | ! jyyyymmdd - output - date as 8 decimal digits (yyyymmdd). |
---|
349 | ! yyyy=year, mm=month, dd=day of month. |
---|
350 | ! jhhmmss - output - time of day as 6 decimal digits (hhmmss). |
---|
351 | ! hh=hour, mm=minute, ss=second |
---|
352 | ! if (jyyyymmdd=jhhmmss=-1, then ierr is non-zero, and vice-versa) |
---|
353 | ! |
---|
354 | |
---|
355 | ! use netcdf |
---|
356 | include 'netcdf.inc' |
---|
357 | !implicit none |
---|
358 | |
---|
359 | |
---|
360 | ! arguments |
---|
361 | integer :: ierr, itime, jyyyymmdd, jhhmmss |
---|
362 | character*(*) fnamenc |
---|
363 | |
---|
364 | ! local variables |
---|
365 | integer,parameter :: ndims_maxbb=4 ! max number of dimensions for a variable |
---|
366 | |
---|
367 | integer :: i, id_var, iret, itype_var |
---|
368 | integer :: iduma, idumb, idumc |
---|
369 | integer :: id_dim(ndims_maxbb) |
---|
370 | integer :: istart(ndims_maxbb), icount(ndims_maxbb) |
---|
371 | integer :: lendim(ndims_maxbb) |
---|
372 | integer :: natts_tot, ncid, ndims |
---|
373 | |
---|
374 | character(len=32) timetext |
---|
375 | character(len=80) varname, varnamenc |
---|
376 | |
---|
377 | ! externals |
---|
378 | ! integer nf_close |
---|
379 | ! integer nf_inq |
---|
380 | ! integer nf_inq_dim |
---|
381 | ! integer nf_open |
---|
382 | |
---|
383 | |
---|
384 | |
---|
385 | jyyyymmdd = -1 |
---|
386 | jhhmmss = -1 |
---|
387 | |
---|
388 | ! |
---|
389 | ! open the netcdf file |
---|
390 | ! |
---|
391 | ncid = 10 |
---|
392 | iret = nf_open( fnamenc, NF_NOWRITE, ncid ) |
---|
393 | if (iret .ne. nf_noerr) then |
---|
394 | write(*,9100) 'error doing open 370', fnamenc |
---|
395 | ierr = -1 |
---|
396 | goto 8100 |
---|
397 | end if |
---|
398 | |
---|
399 | 9100 format( / '*** read_ncwrfout_1datetime -- ', a / & |
---|
400 | 'file = ', a ) |
---|
401 | 9110 format( / '*** read_ncwrfout_1datetime -- ', a, 1x, i8 / & |
---|
402 | 'file = ', a ) |
---|
403 | 9120 format( / '*** read_ncwrfout_1datetime -- ', a, 2(1x,i8) / & |
---|
404 | 'file = ', a ) |
---|
405 | 9130 format( / '*** read_ncwrfout_1datetime -- ', a, 3(1x,i8) / & |
---|
406 | 'file = ', a ) |
---|
407 | 9115 format( / '*** read_ncwrfout_1datetime -- ', a / a, 1x, i8 / & |
---|
408 | 'file = ', a ) |
---|
409 | 9125 format( / '*** read_ncwrfout_1datetime -- ', a / a, 2(1x,i8) / & |
---|
410 | 'file = ', a ) |
---|
411 | 9135 format( / '*** read_ncwrfout_1datetime -- ', a / a, 3(1x,i8) / & |
---|
412 | 'file = ', a ) |
---|
413 | |
---|
414 | 90030 format( a, 2i6, 2(2x,a) ) |
---|
415 | |
---|
416 | ! |
---|
417 | ! get information on the variable |
---|
418 | ! |
---|
419 | varname = 'Times' |
---|
420 | iret = nf_inq_varid( ncid, varname, id_var ) |
---|
421 | if (iret .ne. nf_noerr) then |
---|
422 | write(*,9100) 'error inquiring var id for ' // varname, fnamenc |
---|
423 | ierr = -1 |
---|
424 | goto 8100 |
---|
425 | end if |
---|
426 | |
---|
427 | iret = nf_inq_var( ncid, id_var, & |
---|
428 | varnamenc, itype_var, ndims, id_dim, natts_tot ) |
---|
429 | if (iret .ne. nf_noerr) then |
---|
430 | write(*,9100) 'error inquiring var info for ' // varname, fnamenc |
---|
431 | ierr = -1 |
---|
432 | goto 8100 |
---|
433 | end if |
---|
434 | |
---|
435 | ! check variable type |
---|
436 | if (itype_var .ne. nf_char) then |
---|
437 | write(*,9110) 'var type wrong for ' // varname, & |
---|
438 | itype_var, fnamenc |
---|
439 | ierr = -1 |
---|
440 | goto 8100 |
---|
441 | end if |
---|
442 | |
---|
443 | |
---|
444 | ! check number of dimensions |
---|
445 | if (ndims .ne. 2) then |
---|
446 | write(*,9115) 'var ndims is wrong for ' // varname, & |
---|
447 | 'ndims =', ndims, fnamenc |
---|
448 | ierr = -1 |
---|
449 | goto 8100 |
---|
450 | end if |
---|
451 | |
---|
452 | ! get sizes of dimensions |
---|
453 | ! dimension 1 = # of characters in date/time string |
---|
454 | ! dimension 2 = # of times in the file |
---|
455 | do i = 1, ndims |
---|
456 | iret = nf_inq_dimlen( ncid, id_dim(i), lendim(i) ) |
---|
457 | if (iret .ne. nf_noerr) then |
---|
458 | write(*,9115) 'error inquiring var dim len for ' // varname, & |
---|
459 | 'idim =', i, fnamenc |
---|
460 | ierr = -1 |
---|
461 | goto 8100 |
---|
462 | end if |
---|
463 | end do |
---|
464 | |
---|
465 | if (itime .lt. 1) then |
---|
466 | ierr = -11 |
---|
467 | goto 8100 |
---|
468 | else if (itime .gt. lendim(2)) then |
---|
469 | ierr = -12 |
---|
470 | goto 8100 |
---|
471 | end if |
---|
472 | |
---|
473 | ! get the data and extract the data & time |
---|
474 | do i = 1, ndims_maxbb |
---|
475 | istart(i) = 1 |
---|
476 | icount(i) = 1 |
---|
477 | end do |
---|
478 | istart(1) = 1 |
---|
479 | icount(1) = lendim(1) |
---|
480 | istart(2) = itime |
---|
481 | icount(2) = 1 |
---|
482 | iret = nf_get_vara_text( ncid, id_var, istart, icount, timetext ) |
---|
483 | if (iret .ne. nf_noerr) then |
---|
484 | write(*,9100) 'error reading var data for ' // varname, & |
---|
485 | fnamenc |
---|
486 | ierr = -1 |
---|
487 | goto 8100 |
---|
488 | end if |
---|
489 | |
---|
490 | read( timetext, '(i4,1x,i2,1x,i2)', iostat=iret ) & |
---|
491 | iduma, idumb, idumc |
---|
492 | if (iret .ne. 0) then |
---|
493 | write(*,9125) & |
---|
494 | 'error reading from timetext = "' // timetext // '"', & |
---|
495 | 'itime, lendim(1) =', itime, lendim(1), fnamenc |
---|
496 | ierr = -1 |
---|
497 | goto 8100 |
---|
498 | end if |
---|
499 | jyyyymmdd = iduma*10000 + idumb*100 + idumc |
---|
500 | |
---|
501 | read( timetext, '(11x,i2,1x,i2,1x,i2)', iostat=iret ) & |
---|
502 | iduma, idumb, idumc |
---|
503 | if (iret .ne. 0) then |
---|
504 | write(*,9125) & |
---|
505 | 'error reading from timetext = "' // timetext // '"', & |
---|
506 | 'itime, lendim(1) =', itime, lendim(1), fnamenc |
---|
507 | ierr = -1 |
---|
508 | goto 8100 |
---|
509 | end if |
---|
510 | jhhmmss = iduma*10000 + idumb*100 + idumc |
---|
511 | |
---|
512 | ! |
---|
513 | ! success - close and return |
---|
514 | ! |
---|
515 | iret = nf_close( ncid ) |
---|
516 | ierr = 0 |
---|
517 | return |
---|
518 | |
---|
519 | ! |
---|
520 | ! failure - close and return |
---|
521 | ! |
---|
522 | 8100 iret = nf_close( ncid ) |
---|
523 | return |
---|
524 | |
---|
525 | end subroutine read_ncwrfout_1datetime |
---|
526 | |
---|
527 | |
---|
528 | |
---|
529 | !----------------------------------------------------------------------- |
---|
530 | subroutine read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, & |
---|
531 | varname, vardata, & |
---|
532 | itime, & |
---|
533 | ndims, ndims_exp, ndims_max, & |
---|
534 | lendim, lendim_exp, lendim_max ) |
---|
535 | ! |
---|
536 | ! reads of real (single precision) field at one time from a netcdf wrf output file |
---|
537 | ! |
---|
538 | ! arguments |
---|
539 | ! ierr - output - if non-zero, an error occurred |
---|
540 | ! while opening or reading from the file |
---|
541 | ! -1 = error opening file |
---|
542 | ! -2 = requested variable is not in the file |
---|
543 | ! -3 = error while inquiring about the variable |
---|
544 | ! -4 = variable type is other than real (single precision) |
---|
545 | ! ... = check below, in the code, for explanation of other ierr values. |
---|
546 | ! idiagaa - input - if positive, testing diagnostics are printed |
---|
547 | ! fnamenc - input - path+filename of the wrf output file |
---|
548 | ! varname - input - field name |
---|
549 | ! vardata - output - the data for the field |
---|
550 | ! itime - input - specifies which time to read. |
---|
551 | ! (1 for first time in the file, 2 for second, ...) |
---|
552 | ! ndims - output - number of (netcdf) dimensions of the field. |
---|
553 | ! This includes the time dimension. |
---|
554 | ! ndims_exp - input - expected number of dimensions of the field. |
---|
555 | ! An error occurs if ndims .ne. ndims_exp. |
---|
556 | ! ndims_max - input - The dimension/size of the lendim_... arrays. |
---|
557 | ! lendim - output - The size of each of the "ndims" dimensions. |
---|
558 | ! lendim_exp - input - The expected size of each of the "ndims" dimensions. |
---|
559 | ! If lendim_exp .gt. 0, then an error occurs if lendim .ne. lendim_exp. |
---|
560 | ! lendim_max - input - The maximum size of each dimension. These are |
---|
561 | ! The dimensions of the vardata array. |
---|
562 | ! |
---|
563 | ! use netcdf |
---|
564 | include 'netcdf.inc' |
---|
565 | !implicit none |
---|
566 | |
---|
567 | |
---|
568 | ! arguments |
---|
569 | integer :: ierr, idiagaa, itime, & |
---|
570 | ndims, ndims_exp, ndims_max, & |
---|
571 | lendim(ndims_max), lendim_exp(ndims_max), & |
---|
572 | lendim_max(ndims_max) |
---|
573 | |
---|
574 | real :: vardata( lendim_max(1), lendim_max(2), lendim_max(3) ) |
---|
575 | |
---|
576 | character*(*) fnamenc, varname |
---|
577 | |
---|
578 | ! local variables |
---|
579 | integer,parameter :: ndims_maxbb=4 ! max number of dimensions for a variable |
---|
580 | integer,parameter :: ibadaa=-987 |
---|
581 | integer,parameter :: xbadaa=-987 |
---|
582 | integer,parameter :: ijktestmax=500 |
---|
583 | |
---|
584 | integer :: i, iatt, id_var, iret, itype_var |
---|
585 | integer :: itot, ijktot, ii |
---|
586 | integer :: id_dim(ndims_maxbb) |
---|
587 | integer :: istart(ndims_maxbb), icount(ndims_maxbb) |
---|
588 | integer :: j, jtot, jj |
---|
589 | integer :: k, ktot, kk |
---|
590 | integer :: l, lenatt |
---|
591 | integer :: lendim_use(ndims_maxbb) |
---|
592 | integer :: m |
---|
593 | integer :: natts_tot, ncid, ndiffa, ndiffb |
---|
594 | |
---|
595 | real :: duma, dumb |
---|
596 | real :: testavg(ijktestmax,3,2), & |
---|
597 | testmin(ijktestmax,3,2), testmax(ijktestmax,3,2) |
---|
598 | |
---|
599 | character(len=80) varnamenc |
---|
600 | character(len=80) dimname(ndims_maxbb) |
---|
601 | |
---|
602 | ! externals |
---|
603 | ! integer nf_close |
---|
604 | ! integer nf_inq |
---|
605 | ! integer nf_inq_dim |
---|
606 | ! integer nf_open |
---|
607 | |
---|
608 | ! print*,'dim array',lendim_max(1), lendim_max(2), lendim_max(3) |
---|
609 | |
---|
610 | ! |
---|
611 | ! open the netcdf file |
---|
612 | ! |
---|
613 | ncid = 10 |
---|
614 | iret = nf_open( fnamenc, NF_NOWRITE, ncid ) |
---|
615 | if (iret .ne. nf_noerr) then |
---|
616 | write(*,9100) 'error doing open 592', fnamenc |
---|
617 | ierr = -1 |
---|
618 | return |
---|
619 | end if |
---|
620 | |
---|
621 | 9100 format( / '*** read_ncwrfout_1realfield -- ', a / & |
---|
622 | 'file = ', a ) |
---|
623 | 9110 format( / '*** read_ncwrfout_1realfield -- ', a, 1x, i8 / & |
---|
624 | 'file = ', a ) |
---|
625 | 9120 format( / '*** read_ncwrfout_1realfield -- ', a, 2(1x,i8) / & |
---|
626 | 'file = ', a ) |
---|
627 | 9130 format( / '*** read_ncwrfout_1realfield -- ', a, 3(1x,i8) / & |
---|
628 | 'file = ', a ) |
---|
629 | 9115 format( / '*** read_ncwrfout_1realfield -- ', a / a, 1x, i8 / & |
---|
630 | 'file = ', a ) |
---|
631 | 9125 format( / '*** read_ncwrfout_1realfield -- ', a / a, 2(1x,i8) / & |
---|
632 | 'file = ', a ) |
---|
633 | 9135 format( / '*** read_ncwrfout_1realfield -- ', a / a, 3(1x,i8) / & |
---|
634 | 'file = ', a ) |
---|
635 | |
---|
636 | 90030 format( a, 2i6, 2(2x,a) ) |
---|
637 | |
---|
638 | ! |
---|
639 | ! get information on the variable |
---|
640 | ! |
---|
641 | iret = nf_inq_varid( ncid, varname, id_var ) |
---|
642 | if (iret .ne. nf_noerr) then |
---|
643 | ! write(*,9100) 'error inquiring var id for ' // varname, fnamenc |
---|
644 | ierr = -2 |
---|
645 | goto 8100 |
---|
646 | end if |
---|
647 | |
---|
648 | iret = nf_inq_var( ncid, id_var, & |
---|
649 | varnamenc, itype_var, ndims, id_dim, natts_tot ) |
---|
650 | if (iret .ne. nf_noerr) then |
---|
651 | write(*,9100) 'error inquiring var info for ' // varname, fnamenc |
---|
652 | ierr = -3 |
---|
653 | goto 8100 |
---|
654 | end if |
---|
655 | |
---|
656 | ! check variable type |
---|
657 | if (itype_var .ne. nf_real) then |
---|
658 | write(*,9110) 'var type wrong for ' // varname, & |
---|
659 | itype_var, fnamenc |
---|
660 | ierr = -4 |
---|
661 | goto 8100 |
---|
662 | end if |
---|
663 | |
---|
664 | |
---|
665 | ! check number of dimensions |
---|
666 | if (ndims_exp .le. 0) then |
---|
667 | write(*,9115) & |
---|
668 | 'bad ndims_exp for ' // varname, & |
---|
669 | 'ndims_exp =', ndims_exp, fnamenc |
---|
670 | ierr = -11 |
---|
671 | goto 8100 |
---|
672 | end if |
---|
673 | if (ndims .ne. ndims_exp) then |
---|
674 | write(*,9125) 'var ndims mismatch for ' // varname, & |
---|
675 | 'ndims_exp, ndims =', ndims_exp, ndims, fnamenc |
---|
676 | ierr = -12 |
---|
677 | goto 8100 |
---|
678 | end if |
---|
679 | if (ndims .gt. ndims_max) then |
---|
680 | write(*,9125) 'var ndims > ndims_max for ' // varname, & |
---|
681 | 'ndims, ndims_max =', ndims, ndims_max, fnamenc |
---|
682 | ierr = -13 |
---|
683 | goto 8100 |
---|
684 | end if |
---|
685 | if (ndims .gt. ndims_maxbb) then |
---|
686 | write(*,9125) 'var ndims > ndims_maxbb for ' // varname, & |
---|
687 | 'ndims, ndims_maxbb =', ndims, ndims_maxbb, fnamenc |
---|
688 | ierr = -14 |
---|
689 | goto 8100 |
---|
690 | end if |
---|
691 | |
---|
692 | ! check size of each dimension |
---|
693 | do i = 1, ndims_exp |
---|
694 | iret = nf_inq_dimlen( ncid, id_dim(i), lendim(i) ) |
---|
695 | if (iret .ne. nf_noerr) then |
---|
696 | write(*,9110) 'error inquiring var dim len for ' // varname, & |
---|
697 | i, fnamenc |
---|
698 | ierr = -15 |
---|
699 | goto 8100 |
---|
700 | end if |
---|
701 | if ((i .lt. ndims_exp) .and. (lendim_exp(i) .gt. 0) .and. & |
---|
702 | (lendim(i) .ne. lendim_exp(i))) then |
---|
703 | ! print*,i,ndims_exp,lendim_exp(i),lendim(i),lendim_exp(i) |
---|
704 | write(*,9130) 'var lendim mismatch for ' // varname, & |
---|
705 | i, lendim_exp(i), lendim(i), fnamenc |
---|
706 | ierr = -16 |
---|
707 | goto 8100 |
---|
708 | end if |
---|
709 | if ((i .lt. ndims_exp) .and. & |
---|
710 | (lendim(i) .gt. lendim_max(i))) then |
---|
711 | write(*,9130) 'var lendim too big for ' // varname, & |
---|
712 | i, lendim_max(i), lendim(i), fnamenc |
---|
713 | ierr = -17 |
---|
714 | goto 8100 |
---|
715 | end if |
---|
716 | if ((i .eq. ndims_exp) .and. (lendim(i) .lt. itime)) then |
---|
717 | write(*,9130) 'var itime < ntimes for ' // varname, & |
---|
718 | i, itime, lendim(i), fnamenc |
---|
719 | ierr = -18 |
---|
720 | goto 8100 |
---|
721 | end if |
---|
722 | end do |
---|
723 | |
---|
724 | ! do diagnostics on the dimensions |
---|
725 | if (idiagaa .gt. 0) then |
---|
726 | write(*,'(/a)') & |
---|
727 | 'read_ncwrfout_1realfield - dim info for var = ' // & |
---|
728 | varname(1:20) |
---|
729 | do i = 1, ndims |
---|
730 | iret = nf_inq_dim( ncid, id_dim(i), dimname(i), lendim(i) ) |
---|
731 | if (iret .ne. nf_noerr) then |
---|
732 | write(*,9115) 'error inquiring var dim info for ' // varname, & |
---|
733 | 'idim =', i, fnamenc |
---|
734 | ierr = -19 |
---|
735 | goto 8100 |
---|
736 | end if |
---|
737 | write(*,'(a,3i5,2x,a)') ' i,id,len,name =', & |
---|
738 | i, id_dim(i), lendim(i), dimname(i)(1:32) |
---|
739 | end do |
---|
740 | end if |
---|
741 | |
---|
742 | ! |
---|
743 | ! get the data |
---|
744 | ! |
---|
745 | do i = 1, ndims_maxbb |
---|
746 | istart(i) = 1 |
---|
747 | icount(i) = 1 |
---|
748 | end do |
---|
749 | do i = 1, ndims_exp - 1 |
---|
750 | istart(i) = 1 |
---|
751 | icount(i) = lendim(i) |
---|
752 | end do |
---|
753 | ! in wrfout files, the last dimension should always be time |
---|
754 | istart(ndims_exp) = itime |
---|
755 | icount(ndims_exp) = 1 |
---|
756 | |
---|
757 | iret = nf_get_vara_real( ncid, id_var, istart, icount, vardata ) |
---|
758 | if (iret .ne. nf_noerr) then |
---|
759 | write(*,9120) 'error reading var data for ' // varname, & |
---|
760 | fnamenc |
---|
761 | ierr = -21 |
---|
762 | goto 8100 |
---|
763 | end if |
---|
764 | |
---|
765 | ! |
---|
766 | ! reorder the data |
---|
767 | ! |
---|
768 | lendim_use(1) = lendim(1) |
---|
769 | lendim_use(2) = 1 |
---|
770 | if (ndims_exp .ge. 3) lendim_use(2) = lendim(2) |
---|
771 | lendim_use(3) = 1 |
---|
772 | if (ndims_exp .ge. 4) lendim_use(3) = lendim(3) |
---|
773 | |
---|
774 | ! print*,'dim to go',lendim_use(1),lendim_use(2),lendim_use(3) |
---|
775 | ! print*,'value in',lendim_use, lendim_max |
---|
776 | call reorder_ncwrfout_1realfield( ierr, idiagaa, & |
---|
777 | varname, vardata, vardata, & |
---|
778 | lendim_use, lendim_max ) |
---|
779 | |
---|
780 | if (ierr .ne. 0) then |
---|
781 | print*, 'error re-ordering var data for ', varname, & |
---|
782 | fnamenc |
---|
783 | ierr = -22 |
---|
784 | goto 8100 |
---|
785 | end if |
---|
786 | |
---|
787 | ! |
---|
788 | ! success - close and return |
---|
789 | ! |
---|
790 | iret = nf_close( ncid ) |
---|
791 | ierr = 0 |
---|
792 | return |
---|
793 | |
---|
794 | ! |
---|
795 | ! error - close and return |
---|
796 | ! |
---|
797 | 8100 iret = nf_close( ncid ) |
---|
798 | return |
---|
799 | |
---|
800 | end subroutine read_ncwrfout_1realfield |
---|
801 | |
---|
802 | |
---|
803 | |
---|
804 | !----------------------------------------------------------------------- |
---|
805 | subroutine reorder_ncwrfout_1realfield( ierr, idiagaa, & |
---|
806 | varname, vardata_in, vardata_out, & |
---|
807 | lendim_use, lendim_max ) |
---|
808 | ! |
---|
809 | ! reorders a real (single precision) field |
---|
810 | ! the nf_get_vara_real loads the data for a field into |
---|
811 | ! a contiguous block of memory starting at vardata(1,1,1) |
---|
812 | ! it does not know if perhaps lendim() < lendim_max() |
---|
813 | ! this routine corrects for that, so that the data are |
---|
814 | ! loaded into non-contiguous blocks when lendim() < lendim_max() |
---|
815 | ! |
---|
816 | ! arguments |
---|
817 | ! ierr - output - if non-zero, an error occurred while re-ordering |
---|
818 | ! idiagaa - input - if positive, testing diagnostics are printed |
---|
819 | ! varname - input - field name |
---|
820 | ! |
---|
821 | ! vardata_in - input - the data for the field |
---|
822 | ! vardata_out - output - the data for the field |
---|
823 | ! In the calling program, vardata_in & vardata_out are usually |
---|
824 | ! the same array. This routine "pretends" that they are |
---|
825 | ! different, and specifies their dimensions differently, |
---|
826 | ! to facilitate the reordering. |
---|
827 | ! |
---|
828 | ! lendim_use - input - The actual size of the spatial dimensions of the field. |
---|
829 | ! lendim_max - input - The actual spatial dimensions of the vardata array. |
---|
830 | ! Most wrf fields are spatially either 1d (z), 2d (xy), or 3d (xyz). |
---|
831 | ! For a 1d spatial field (e.g., z only), set |
---|
832 | ! lendim_use(1) = nz, lendim_max(1) = nz_max |
---|
833 | ! lendim_use(2) = 1, lendim_max(2) = 1 |
---|
834 | ! lendim_use(3) = 1, lendim_max(3) = 1 |
---|
835 | ! For a 2d spatial field (e.g., xy only), set |
---|
836 | ! lendim_use(1) = nx, lendim_max(1) = nx_max |
---|
837 | ! lendim_use(2) = ny lendim_max(2) = ny_max |
---|
838 | ! lendim_use(3) = 1, lendim_max(3) = 1 |
---|
839 | ! For a 3d spatial field (xyz), set |
---|
840 | ! lendim_use(1) = nx, lendim_max(1) = nx_max |
---|
841 | ! lendim_use(2) = ny lendim_max(2) = ny_max |
---|
842 | ! lendim_use(3) = nz lendim_max(3) = nz_max |
---|
843 | ! |
---|
844 | |
---|
845 | ! use netcdf |
---|
846 | include 'netcdf.inc' |
---|
847 | !implicit none |
---|
848 | |
---|
849 | |
---|
850 | ! arguments |
---|
851 | integer :: ierr, idiagaa, & |
---|
852 | lendim_use(3), lendim_max(3) |
---|
853 | |
---|
854 | real :: vardata_in( lendim_use(1), lendim_use(2), lendim_use(3) ) |
---|
855 | real :: vardata_out( lendim_max(1), lendim_max(2), lendim_max(3) ) |
---|
856 | |
---|
857 | character*(*) varname |
---|
858 | |
---|
859 | ! local variables |
---|
860 | integer,parameter :: ijktestmax=500 |
---|
861 | integer,parameter :: check_reordering=1 |
---|
862 | |
---|
863 | integer :: i, j, k, m, n |
---|
864 | integer :: itestend, jtestend, ktestend |
---|
865 | integer :: ijk, ijktestend |
---|
866 | integer :: ndiffa, ndiffb |
---|
867 | |
---|
868 | real :: duma, dumb |
---|
869 | real :: testavg(ijktestmax,3,2), & |
---|
870 | testmin(ijktestmax,3,2), testmax(ijktestmax,3,2) |
---|
871 | |
---|
872 | ! |
---|
873 | ! the testavg/min/max are avg, min, and max values for |
---|
874 | ! a i (or j or k) fixed and j,k (or i,k or i,j) varying |
---|
875 | ! they are computed before and after the data has been reordered |
---|
876 | ! then compared at the end |
---|
877 | ! an error occurs if they do not match |
---|
878 | ! |
---|
879 | ! print*,'size in out',lendim_use(1), lendim_use(2), lendim_use(3) |
---|
880 | ! print*,'size in out',lendim_max(1), lendim_max(2), lendim_max(3) |
---|
881 | if (check_reordering .gt. 0) then |
---|
882 | |
---|
883 | do n = 1, 2 |
---|
884 | do m = 1, 3 |
---|
885 | do i = 1, ijktestmax |
---|
886 | testavg(i,m,n) = 0.0 |
---|
887 | testmin(i,m,n) = +1.0e37 |
---|
888 | testmax(i,m,n) = -1.0e37 |
---|
889 | end do |
---|
890 | end do |
---|
891 | end do |
---|
892 | ! print*,varname |
---|
893 | ktestend = min( ijktestmax, lendim_use(3) ) |
---|
894 | jtestend = min( ijktestmax, lendim_use(2) ) |
---|
895 | itestend = min( ijktestmax, lendim_use(1) ) |
---|
896 | ! print*,'ktestend',ktestend |
---|
897 | ! pass 1 -- compute the test---(:,:,1) from vardata_in |
---|
898 | do k = 1, ktestend |
---|
899 | do j = 1, jtestend |
---|
900 | do i = 1, itestend |
---|
901 | duma = vardata_in(i,j,k) |
---|
902 | testavg(i,1,1) = testavg(i,1,1) + duma |
---|
903 | testmin(i,1,1) = min( testmin(i,1,1), duma ) |
---|
904 | testmax(i,1,1) = max( testmax(i,1,1), duma ) |
---|
905 | testavg(j,2,1) = testavg(j,2,1) + duma |
---|
906 | testmin(j,2,1) = min( testmin(j,2,1), duma ) |
---|
907 | testmax(j,2,1) = max( testmax(j,2,1), duma ) |
---|
908 | testavg(k,3,1) = testavg(k,3,1) + duma |
---|
909 | testmin(k,3,1) = min( testmin(k,3,1), duma ) |
---|
910 | testmax(k,3,1) = max( testmax(k,3,1), duma ) |
---|
911 | end do |
---|
912 | end do |
---|
913 | end do |
---|
914 | |
---|
915 | end if ! if (check_reordering .gt. 0) then |
---|
916 | |
---|
917 | ! pass 2 -- shift the data values |
---|
918 | ! print*,'max',lendim_max |
---|
919 | do k = lendim_use(3), 1, -1 |
---|
920 | do j = lendim_use(2), 1, -1 |
---|
921 | do i = lendim_use(1), 1, -1 |
---|
922 | ! print*,i,j,k |
---|
923 | vardata_out(i,j,k) = vardata_in(i,j,k) |
---|
924 | end do |
---|
925 | end do |
---|
926 | end do |
---|
927 | |
---|
928 | ! pass 3 -- compute the test---(:,:,2) from vardata_out |
---|
929 | if (check_reordering .gt. 0) then |
---|
930 | |
---|
931 | do k = 1, ktestend |
---|
932 | do j = 1, jtestend |
---|
933 | do i = 1, itestend |
---|
934 | duma = vardata_out(i,j,k) |
---|
935 | testavg(i,1,2) = testavg(i,1,2) + duma |
---|
936 | testmin(i,1,2) = min( testmin(i,1,2), duma ) |
---|
937 | testmax(i,1,2) = max( testmax(i,1,2), duma ) |
---|
938 | testavg(j,2,2) = testavg(j,2,2) + duma |
---|
939 | testmin(j,2,2) = min( testmin(j,2,2), duma ) |
---|
940 | testmax(j,2,2) = max( testmax(j,2,2), duma ) |
---|
941 | testavg(k,3,2) = testavg(k,3,2) + duma |
---|
942 | testmin(k,3,2) = min( testmin(k,3,2), duma ) |
---|
943 | testmax(k,3,2) = max( testmax(k,3,2), duma ) |
---|
944 | end do |
---|
945 | end do |
---|
946 | end do |
---|
947 | |
---|
948 | ! now compare the test---(:,:,1) & test---(:,:,2) |
---|
949 | ndiffb = 0 |
---|
950 | do m = 1, 3 |
---|
951 | if (m .eq. 1) then |
---|
952 | ijktestend = itestend |
---|
953 | duma = 1.0/(jtestend*ktestend) |
---|
954 | if (idiagaa .gt. 0) write(*,'(a,a)') varname(1:20), & |
---|
955 | 'i, testavg(i,1), testmin(i,1), testmax(i,1)' |
---|
956 | else if (m .eq. 2) then |
---|
957 | ijktestend = jtestend |
---|
958 | duma = 1.0/(itestend*ktestend) |
---|
959 | if (idiagaa .gt. 0) write(*,'(a,a)') varname(1:20), & |
---|
960 | 'j, testavg(j,2), testmin(j,2), testmax(j,2)' |
---|
961 | else |
---|
962 | ijktestend = ktestend |
---|
963 | duma = 1.0/(itestend*jtestend) |
---|
964 | if (idiagaa .gt. 0) write(*,'(a,a)') varname(1:20), & |
---|
965 | 'k, testavg(k,3), testmin(k,3), testmax(k,3)' |
---|
966 | end if |
---|
967 | |
---|
968 | ndiffa = 0 |
---|
969 | do ijk = 1, ijktestend |
---|
970 | i = ijk |
---|
971 | dumb = max( abs(testavg(i,m,1)), abs(testavg(i,m,2)) )*2.0e-7 |
---|
972 | if (abs(testavg(i,m,1)-testavg(i,m,2)) .gt. dumb) ndiffa = ndiffa + 1 |
---|
973 | dumb = max( abs(testmin(i,m,1)), abs(testmin(i,m,2)) )*2.0e-7 |
---|
974 | if (abs(testmin(i,m,1)-testmin(i,m,2)) .gt. dumb) ndiffa = ndiffa + 1 |
---|
975 | dumb = max( abs(testmax(i,m,1)), abs(testmax(i,m,2)) )*2.0e-7 |
---|
976 | if (abs(testmax(i,m,1)-testmax(i,m,2)) .gt. dumb) ndiffa = ndiffa + 1 |
---|
977 | end do |
---|
978 | |
---|
979 | if (ndiffa .le. 0) then |
---|
980 | if (idiagaa .gt. 0) write(*,*) ' *** no differences' |
---|
981 | else |
---|
982 | do ijk = 1, ijktestend |
---|
983 | i = ijk |
---|
984 | if (idiagaa .gt. 0) write(*,'(i3,1p,3(2x,2e11.3))') i, & |
---|
985 | testavg(i,m,1)*duma, & |
---|
986 | (testavg(i,m,1)-testavg(i,m,2))*duma, & |
---|
987 | testmin(i,m,1), (testmin(i,m,1)-testmin(i,m,2)), & |
---|
988 | testmax(i,m,1), (testmax(i,m,1)-testmax(i,m,2)) |
---|
989 | end do |
---|
990 | end if |
---|
991 | |
---|
992 | ndiffb = ndiffb + ndiffa |
---|
993 | end do |
---|
994 | |
---|
995 | if (ndiffb .gt. 0) then |
---|
996 | ierr = -12 |
---|
997 | goto 8100 |
---|
998 | end if |
---|
999 | |
---|
1000 | end if ! if (check_reordering .gt. 0) then |
---|
1001 | |
---|
1002 | ! |
---|
1003 | ! success |
---|
1004 | ! |
---|
1005 | ierr = 0 |
---|
1006 | return |
---|
1007 | |
---|
1008 | ! |
---|
1009 | ! error |
---|
1010 | ! |
---|
1011 | 8100 return |
---|
1012 | |
---|
1013 | end subroutine reorder_ncwrfout_1realfield |
---|
1014 | |
---|
1015 | |
---|
1016 | |
---|