Line data Source code
1 : #ifdef ncdf
2 : #define USE_NETCDF
3 : #endif
4 : !=======================================================================
5 :
6 : ! Routines for opening, reading and writing external files
7 : !
8 : ! author: Tony Craig, NCAR
9 : !
10 : ! 2004: Block structure added by William Lipscomb, LANL
11 : ! 2006: Converted to free source form (F90) by Elizabeth Hunke
12 : ! 2007: netcdf versions added by Alison McLaren & Ann Keen, Met Office
13 :
14 : module ice_read_write
15 :
16 : use ice_kinds_mod
17 : use ice_constants, only: c0, spval_dbl, &
18 : field_loc_noupdate, field_type_noupdate
19 : use ice_communicate, only: my_task, master_task
20 : use ice_broadcast, only: broadcast_scalar
21 : use ice_domain, only: distrb_info, orca_halogrid
22 : use ice_domain_size, only: max_blocks, nx_global, ny_global, ncat
23 : use ice_blocks, only: nx_block, ny_block, nghost
24 : use ice_exit, only: abort_ice
25 : use ice_fileunits, only: nu_diag
26 :
27 : #ifdef USE_NETCDF
28 : use netcdf
29 : #endif
30 :
31 : implicit none
32 :
33 : private
34 :
35 : integer (kind=int_kind), parameter, private :: &
36 : bits_per_byte = 8 ! number of bits per byte.
37 : ! used to determine RecSize in ice_open
38 :
39 : public :: ice_open, &
40 : ice_open_ext, & ! LCOV_EXCL_LINE
41 : ice_open_nc, & ! LCOV_EXCL_LINE
42 : ice_read, & ! LCOV_EXCL_LINE
43 : ice_read_ext, & ! LCOV_EXCL_LINE
44 : ice_read_nc, & ! LCOV_EXCL_LINE
45 : ice_read_global, & ! LCOV_EXCL_LINE
46 : ice_read_global_nc, & ! LCOV_EXCL_LINE
47 : ice_read_nc_uv, & ! LCOV_EXCL_LINE
48 : ice_read_nc_xyf, & ! LCOV_EXCL_LINE
49 : ice_write, & ! LCOV_EXCL_LINE
50 : ice_write_nc, & ! LCOV_EXCL_LINE
51 : ice_write_ext, & ! LCOV_EXCL_LINE
52 : ice_read_vec_nc, & ! LCOV_EXCL_LINE
53 : ice_get_ncvarsize, & ! LCOV_EXCL_LINE
54 : ice_close_nc
55 :
56 : interface ice_write
57 : module procedure ice_write_xyt, &
58 : ice_write_xyzt
59 : end interface
60 :
61 : interface ice_read
62 : module procedure ice_read_xyt, &
63 : ice_read_xyzt
64 : end interface
65 :
66 : interface ice_read_nc
67 : module procedure ice_read_nc_xy, &
68 : ice_read_nc_xyz, & ! LCOV_EXCL_LINE
69 : !ice_read_nc_xyf, & ! LCOV_EXCL_LINE
70 : ice_read_nc_point, & ! LCOV_EXCL_LINE
71 : ice_read_nc_1D, & ! LCOV_EXCL_LINE
72 : ice_read_nc_2D, & ! LCOV_EXCL_LINE
73 : ice_read_nc_3D, & ! LCOV_EXCL_LINE
74 : ice_read_nc_z
75 : end interface
76 :
77 : interface ice_write_nc
78 : module procedure ice_write_nc_xy, &
79 : ice_write_nc_xyz
80 : end interface
81 :
82 : !=======================================================================
83 :
84 : contains
85 :
86 : !=======================================================================
87 :
88 : ! Opens an unformatted file for reading.
89 : ! nbits indicates whether the file is sequential or direct access.
90 : !
91 : ! author: Tony Craig, NCAR
92 :
93 84 : subroutine ice_open(nu, filename, nbits, algn)
94 :
95 : integer (kind=int_kind), intent(in) :: &
96 : nu , & ! unit number ! LCOV_EXCL_LINE
97 : nbits ! no. of bits per variable (0 for sequential access)
98 :
99 : integer (kind=int_kind), intent(in), optional :: algn
100 : integer (kind=int_kind) :: RecSize, Remnant, nbytes
101 :
102 : character (*) :: filename
103 :
104 : character(len=*), parameter :: subname = '(ice_open)'
105 :
106 84 : if (my_task == master_task) then
107 :
108 20 : if (nbits == 0) then ! sequential access
109 :
110 0 : open(nu,file=filename,form='unformatted')
111 :
112 : else ! direct access
113 :
114 : ! use nbytes to compute RecSize.
115 : ! this prevents integer overflow with large global grids using nbits
116 : ! nx*ny*nbits > 2^31 -1 (i.e., global grid 9000x7054x64)
117 20 : nbytes = nbits/bits_per_byte
118 20 : RecSize = nx_global*ny_global*nbytes
119 :
120 20 : if (present(algn)) then
121 : ! If data is keept in blocks using given sizes (=algn)
122 : ! Used in eg. HYCOM binary files, which are stored as "blocks" dividable by 16384 bit (=algn)
123 0 : if (algn /= 0) then
124 0 : Remnant = modulo(RecSize,algn)
125 0 : if (Remnant /= 0) then
126 0 : RecSize = RecSize + (algn - Remnant)
127 : endif
128 : endif
129 : endif
130 : open(nu,file=filename,recl=RecSize, &
131 20 : form='unformatted',access='direct')
132 : endif ! nbits = 0
133 :
134 : endif ! my_task = master_task
135 :
136 84 : end subroutine ice_open
137 :
138 : !=======================================================================
139 :
140 : ! Opens an unformatted file for reading, incl ghost cells (direct access).
141 : ! nbits indicates whether the file is sequential or direct access.
142 : !
143 : ! authors: Tony Craig, NCAR
144 : ! David Hebert, NRLSSC
145 :
146 0 : subroutine ice_open_ext(nu, filename, nbits)
147 :
148 : integer (kind=int_kind), intent(in) :: &
149 : nu , & ! unit number ! LCOV_EXCL_LINE
150 : nbits ! no. of bits per variable (0 for sequential access)
151 :
152 : integer (kind=int_kind) :: RecSize, nbytes
153 :
154 : character (*) :: filename
155 :
156 : integer (kind=int_kind) :: &
157 : nx, ny ! grid dimensions including ghost cells
158 :
159 : character(len=*), parameter :: subname = '(ice_open_ext)'
160 :
161 0 : if (my_task == master_task) then
162 :
163 0 : if (nbits == 0) then ! sequential access
164 :
165 0 : open(nu,file=filename,form='unformatted')
166 :
167 : else ! direct access
168 :
169 0 : nx = nx_global + 2*nghost
170 0 : ny = ny_global + 2*nghost
171 :
172 : ! use nbytes to compute RecSize.
173 : ! this prevents integer overflow with large global grids using nbits
174 : ! nx*ny*nbits > 2^31 -1 (i.e., global grid 9000x7054x64)
175 0 : nbytes = nbits/bits_per_byte
176 0 : RecSize = nx*ny*nbytes
177 : open(nu,file=filename,recl=RecSize, &
178 0 : form='unformatted',access='direct')
179 : endif ! nbits = 0
180 :
181 : endif ! my_task = master_task
182 :
183 0 : end subroutine ice_open_ext
184 :
185 : !=======================================================================
186 :
187 : ! Read an unformatted file and scatter to processors.
188 : ! work is a real array, atype indicates the format of the data.
189 : ! If the optional variables field_loc and field_type are present,
190 : ! the ghost cells are filled using values from the global array.
191 : ! This prevents them from being filled with zeroes in land cells
192 : ! (subroutine ice_HaloUpdate need not be called).
193 : !
194 : ! author: Tony Craig, NCAR
195 :
196 13 : subroutine ice_read_xyt(nu, nrec, work, atype, diag, &
197 : field_loc, field_type, & ! LCOV_EXCL_LINE
198 : ignore_eof, hit_eof)
199 :
200 : use ice_gather_scatter, only: scatter_global
201 :
202 : integer (kind=int_kind), intent(in) :: &
203 : nu , & ! unit number ! LCOV_EXCL_LINE
204 : nrec ! record number (0 for sequential access)
205 :
206 : real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(out) :: &
207 : work ! output array (real, 8-byte)
208 :
209 : character (len=4), intent(in) :: &
210 : atype ! format for input array
211 : ! (real/integer, 4-byte/8-byte)
212 :
213 : logical (kind=log_kind), intent(in) :: &
214 : diag ! if true, write diagnostic output
215 :
216 : integer (kind=int_kind), optional, intent(in) :: &
217 : field_loc, & ! location of field on staggered grid ! LCOV_EXCL_LINE
218 : field_type ! type of field (scalar, vector, angle)
219 :
220 : logical (kind=log_kind), optional, intent(in) :: ignore_eof
221 : logical (kind=log_kind), optional, intent(out) :: hit_eof
222 :
223 : ! local variables
224 :
225 : integer (kind=int_kind) :: i, j, ios
226 :
227 : real (kind=dbl_kind) :: &
228 8 : amin, amax, asum ! min, max values and sum of input array
229 :
230 : logical (kind=log_kind) :: ignore_eof_use
231 :
232 : real (kind=dbl_kind), dimension(:,:), allocatable :: &
233 21 : work_g1
234 :
235 : real (kind=real_kind), dimension(:,:), allocatable :: &
236 21 : work_gr
237 :
238 : integer(kind=int_kind), dimension(:,:), allocatable :: &
239 21 : work_gi4
240 :
241 : integer(selected_int_kind(13)), dimension(:,:), allocatable :: &
242 21 : work_gi8
243 :
244 : character(len=*), parameter :: subname = '(ice_read_xyt)'
245 :
246 21 : if (my_task == master_task) then
247 5 : allocate(work_g1(nx_global,ny_global))
248 : else
249 16 : allocate(work_g1(1,1)) ! to save memory
250 : endif
251 :
252 21 : if (my_task == master_task) then
253 :
254 : !-------------------------------------------------------------------
255 : ! Read global array according to format atype
256 : !-------------------------------------------------------------------
257 5 : if (present(hit_eof)) hit_eof = .false.
258 :
259 5 : if (atype == 'ida4') then
260 5 : allocate(work_gi4(nx_global,ny_global))
261 5 : read(nu,rec=nrec) work_gi4
262 58590 : work_g1 = real(work_gi4,kind=dbl_kind)
263 5 : deallocate(work_gi4)
264 0 : elseif (atype == 'ida8') then
265 0 : allocate(work_gi8(nx_global,ny_global))
266 0 : read(nu,rec=nrec) work_gi8
267 0 : work_g1 = real(work_gi8,kind=dbl_kind)
268 0 : deallocate(work_gi8)
269 0 : elseif (atype == 'rda4') then
270 0 : allocate(work_gr(nx_global,ny_global))
271 0 : read(nu,rec=nrec) work_gr
272 0 : work_g1 = work_gr
273 0 : deallocate(work_gr)
274 0 : elseif (atype == 'rda8') then
275 0 : read(nu,rec=nrec) work_g1
276 0 : elseif (atype == 'ruf8') then
277 0 : if (present(ignore_eof)) then
278 0 : ignore_eof_use = ignore_eof
279 : else
280 0 : ignore_eof_use = .false.
281 : endif
282 0 : if (ignore_eof_use) then
283 : ! Read line from file, checking for end-of-file
284 0 : read(nu, iostat=ios) ((work_g1(i,j),i=1,nx_global), &
285 0 : j=1,ny_global)
286 0 : if (present(hit_eof)) hit_eof = ios < 0
287 : else
288 0 : read(nu) ((work_g1(i,j),i=1,nx_global),j=1,ny_global)
289 : endif
290 : else
291 0 : write(nu_diag,*) subname,' ERROR: reading unknown atype ',atype
292 : endif
293 : endif ! my_task = master_task
294 :
295 21 : if (present(hit_eof)) then
296 0 : call broadcast_scalar(hit_eof,master_task)
297 0 : if (hit_eof) then
298 0 : deallocate(work_g1)
299 0 : return
300 : endif
301 : endif
302 :
303 : !-------------------------------------------------------------------
304 : ! optional diagnostics
305 : !-------------------------------------------------------------------
306 21 : if (my_task==master_task .and. diag) then
307 58585 : amin = minval(work_g1)
308 58585 : amax = maxval(work_g1, mask = work_g1 /= spval_dbl)
309 58585 : asum = sum(work_g1, mask = work_g1 /= spval_dbl)
310 5 : write(nu_diag,*) subname,' read_global ',nu, nrec, amin, amax, asum
311 : endif
312 :
313 : !-------------------------------------------------------------------
314 : ! Scatter data to individual processors.
315 : ! NOTE: Ghost cells are not updated unless field_loc is present.
316 : !-------------------------------------------------------------------
317 :
318 21 : if (present(field_loc)) then
319 0 : call scatter_global(work, work_g1, master_task, distrb_info, &
320 21 : field_loc, field_type)
321 : else
322 0 : call scatter_global(work, work_g1, master_task, distrb_info, &
323 0 : field_loc_noupdate, field_type_noupdate)
324 : endif
325 :
326 21 : deallocate(work_g1)
327 :
328 21 : end subroutine ice_read_xyt
329 :
330 : !=======================================================================
331 : ! Read an unformatted file and scatter to processors.
332 : ! work is a real array, atype indicates the format of the data.
333 : ! If the optional variables field_loc and field_type are present,
334 : ! the ghost cells are filled using values from the global array.
335 : ! This prevents them from being filled with zeroes in land cells
336 : ! (subroutine ice_HaloUpdate need not be called).
337 : !
338 : ! author: Tony Craig, NCAR
339 :
340 0 : subroutine ice_read_xyzt(nu, nrec, work, atype, diag, &
341 : field_loc, field_type, & ! LCOV_EXCL_LINE
342 : ignore_eof, hit_eof)
343 :
344 : use ice_gather_scatter, only: scatter_global
345 : use ice_domain_size, only: nblyr
346 :
347 : integer (kind=int_kind), intent(in) :: &
348 : nu , & ! unit number ! LCOV_EXCL_LINE
349 : nrec ! record number (0 for sequential access)
350 :
351 : real (kind=dbl_kind), dimension(nx_block,ny_block,nblyr+2,max_blocks), intent(out) :: &
352 : work ! output array (real, 8-byte)
353 :
354 : character (len=4), intent(in) :: &
355 : atype ! format for input array
356 : ! (real/integer, 4-byte/8-byte)
357 :
358 : logical (kind=log_kind), intent(in) :: &
359 : diag ! if true, write diagnostic output
360 :
361 : integer (kind=int_kind), optional, intent(in) :: &
362 : field_loc, & ! location of field on staggered grid ! LCOV_EXCL_LINE
363 : field_type ! type of field (scalar, vector, angle)
364 :
365 : logical (kind=log_kind), optional, intent(in) :: ignore_eof
366 : logical (kind=log_kind), optional, intent(out) :: hit_eof
367 :
368 : ! local variables
369 :
370 : integer (kind=int_kind) :: i, j, k, ios
371 :
372 : real (kind=dbl_kind) :: &
373 0 : amin, amax, asum ! min, max values and sum of input array
374 :
375 : logical (kind=log_kind) :: ignore_eof_use
376 :
377 :
378 : real (kind=dbl_kind), dimension(:,:,:), allocatable :: &
379 0 : work_g4
380 :
381 : integer(kind=int_kind), dimension(:,:,:), allocatable :: &
382 0 : work_gi5
383 :
384 : integer(selected_int_kind(13)), dimension(:,:,:), allocatable :: &
385 0 : work_gi9
386 :
387 : real (kind=real_kind), dimension(:,:,:), allocatable :: &
388 0 : work_gr3
389 :
390 : character(len=*), parameter :: subname = '(ice_read_xyzt)'
391 :
392 0 : if (my_task == master_task) then
393 0 : allocate(work_g4(nx_global,ny_global,nblyr+2))
394 : else
395 0 : allocate(work_g4(1,1,nblyr+2)) ! to save memory
396 : endif
397 :
398 0 : if (my_task == master_task) then
399 :
400 : !-------------------------------------------------------------------
401 : ! Read global array according to format atype
402 : !-------------------------------------------------------------------
403 0 : if (present(hit_eof)) hit_eof = .false.
404 :
405 0 : if (atype == 'ida4') then
406 0 : allocate(work_gi5(nx_global,ny_global,nblyr+2))
407 0 : read(nu,rec=nrec) work_gi5
408 0 : work_g4 = real(work_gi5,kind=dbl_kind)
409 0 : deallocate(work_gi5)
410 0 : elseif (atype == 'ida8') then
411 0 : allocate(work_gi9(nx_global,ny_global,nblyr+2))
412 0 : read(nu,rec=nrec) work_gi9
413 0 : work_g4 = real(work_gi9,kind=dbl_kind)
414 0 : deallocate(work_gi9)
415 0 : elseif (atype == 'rda4') then
416 0 : allocate(work_gr3(nx_global,ny_global,nblyr+2))
417 0 : read(nu,rec=nrec) work_gr3
418 0 : work_g4 = work_gr3
419 0 : deallocate(work_gr3)
420 0 : elseif (atype == 'rda8') then
421 0 : read(nu,rec=nrec) work_g4
422 0 : elseif (atype == 'ruf8') then
423 0 : if (present(ignore_eof)) then
424 0 : ignore_eof_use = ignore_eof
425 : else
426 0 : ignore_eof_use = .false.
427 : endif
428 0 : if (ignore_eof_use) then
429 : ! Read line from file, checking for end-of-file
430 0 : read(nu, iostat=ios) (((work_g4(i,j,k),i=1,nx_global), &
431 : j=1,ny_global), & ! LCOV_EXCL_LINE
432 0 : k=1,nblyr+2)
433 0 : if (present(hit_eof)) hit_eof = ios < 0
434 : else
435 0 : read(nu) (((work_g4(i,j,k),i=1,nx_global),j=1,ny_global),&
436 0 : k=1,nblyr+2)
437 : endif
438 : else
439 0 : write(nu_diag,*) subname,' ERROR: reading unknown atype ',atype
440 : endif
441 : endif ! my_task = master_task
442 :
443 0 : if (present(hit_eof)) then
444 0 : call broadcast_scalar(hit_eof,master_task)
445 0 : if (hit_eof) then
446 0 : deallocate(work_g4)
447 0 : return
448 : endif
449 : endif
450 :
451 : !-------------------------------------------------------------------
452 : ! optional diagnostics
453 : !-------------------------------------------------------------------
454 0 : if (my_task==master_task .and. diag) then
455 0 : amin = minval(work_g4)
456 0 : amax = maxval(work_g4, mask = work_g4 /= spval_dbl)
457 0 : asum = sum (work_g4, mask = work_g4 /= spval_dbl)
458 0 : write(nu_diag,*) subname,' read_global ',nu, nrec, amin, amax, asum
459 : endif
460 :
461 : !-------------------------------------------------------------------
462 : ! Scatter data to individual processors.
463 : ! NOTE: Ghost cells are not updated unless field_loc is present.
464 : !-------------------------------------------------------------------
465 :
466 0 : do k = 1, nblyr+2
467 :
468 0 : if (present(field_loc)) then
469 0 : call scatter_global(work(:,:,k,:), work_g4(:,:,k), master_task, distrb_info, &
470 0 : field_loc, field_type)
471 :
472 : else
473 :
474 0 : call scatter_global(work(:,:,k,:), work_g4(:,:,k), master_task, distrb_info, &
475 0 : field_loc_noupdate, field_type_noupdate)
476 : endif
477 :
478 : enddo !k
479 0 : deallocate(work_g4)
480 :
481 0 : end subroutine ice_read_xyzt
482 :
483 : !=======================================================================
484 :
485 : ! Read an unformatted file
486 : ! Just like ice_read except that it returns a global array.
487 : ! work_g is a real array, atype indicates the format of the data
488 : !
489 : ! Adapted by William Lipscomb, LANL, from ice_read
490 :
491 91 : subroutine ice_read_global (nu, nrec, work_g, atype, diag, &
492 : ignore_eof, hit_eof)
493 :
494 : integer (kind=int_kind), intent(in) :: &
495 : nu , & ! unit number ! LCOV_EXCL_LINE
496 : nrec ! record number (0 for sequential access)
497 :
498 : real (kind=dbl_kind), dimension(nx_global,ny_global), intent(out) :: &
499 : work_g ! output array (real, 8-byte)
500 :
501 : character (len=4) :: &
502 : atype ! format for input array
503 : ! (real/integer, 4-byte/8-byte)
504 :
505 : logical (kind=log_kind) :: &
506 : diag ! if true, write diagnostic output
507 :
508 : logical (kind=log_kind), optional, intent(in) :: ignore_eof
509 : logical (kind=log_kind), optional, intent(out) :: hit_eof
510 :
511 : ! local variables
512 :
513 : integer (kind=int_kind) :: i, j, ios
514 :
515 : real (kind=dbl_kind) :: &
516 56 : amin, amax, asum ! min, max values and sum of input array
517 :
518 : logical (kind=log_kind) :: ignore_eof_use
519 :
520 : real (kind=real_kind), dimension(:,:), allocatable :: &
521 147 : work_gr
522 :
523 : integer(kind=int_kind), dimension(:,:), allocatable :: &
524 147 : work_gi4
525 :
526 : integer(selected_int_kind(13)), dimension(:,:), allocatable :: &
527 147 : work_gi8
528 :
529 : character(len=*), parameter :: subname = '(ice_read_global)'
530 :
531 1722399 : work_g(:,:) = c0
532 :
533 147 : if (my_task == master_task) then
534 :
535 : !-------------------------------------------------------------------
536 : ! Read global array according to format atype
537 : !-------------------------------------------------------------------
538 35 : if (present(hit_eof)) hit_eof = .false.
539 :
540 35 : if (atype == 'ida4') then
541 5 : allocate(work_gi4(nx_global,ny_global))
542 5 : read(nu,rec=nrec) work_gi4
543 58585 : work_g = real(work_gi4,kind=dbl_kind)
544 5 : deallocate(work_gi4)
545 30 : elseif (atype == 'ida8') then
546 0 : allocate(work_gi8(nx_global,ny_global))
547 0 : read(nu,rec=nrec) work_gi8
548 0 : work_g = real(work_gi8,kind=dbl_kind)
549 0 : deallocate(work_gi8)
550 30 : elseif (atype == 'rda4') then
551 0 : allocate(work_gr(nx_global,ny_global))
552 0 : read(nu,rec=nrec) work_gr
553 0 : work_g = work_gr
554 0 : deallocate(work_gr)
555 30 : elseif (atype == 'rda8') then
556 30 : read(nu,rec=nrec) work_g
557 0 : elseif (atype == 'ruf8') then
558 0 : if (present(ignore_eof)) then
559 0 : ignore_eof_use = ignore_eof
560 : else
561 0 : ignore_eof_use = .false.
562 : endif
563 0 : if (ignore_eof_use) then
564 : ! Read line from file, checking for end-of-file
565 0 : read(nu, iostat=ios) ((work_g(i,j),i=1,nx_global), &
566 0 : j=1,ny_global)
567 0 : if (present(hit_eof)) hit_eof = ios < 0
568 : else
569 0 : read(nu) ((work_g(i,j),i=1,nx_global),j=1,ny_global)
570 : endif
571 : else
572 0 : write(nu_diag,*) subname,' ERROR: reading unknown atype ',atype
573 : endif
574 : endif ! my_task = master_task
575 :
576 147 : if (present(hit_eof)) then
577 0 : call broadcast_scalar(hit_eof,master_task)
578 0 : if (hit_eof) return
579 : endif
580 :
581 : !-------------------------------------------------------------------
582 : ! optional diagnostics
583 : !-------------------------------------------------------------------
584 147 : if (my_task == master_task .and. diag) then
585 410095 : amin = minval(work_g)
586 410095 : amax = maxval(work_g, mask = work_g /= spval_dbl)
587 410095 : asum = sum (work_g, mask = work_g /= spval_dbl)
588 35 : write(nu_diag,*) subname,' read_global ',nu, nrec, amin, amax,asum
589 : endif
590 :
591 147 : end subroutine ice_read_global
592 :
593 : !=======================================================================
594 :
595 : ! Read an unformatted file and scatter to processors, incl ghost cells.
596 : ! work is a real array, atype indicates the format of the data.
597 : ! (subroutine ice_HaloUpdate need not be called).
598 :
599 0 : subroutine ice_read_ext(nu, nrec, work, atype, diag, &
600 : ignore_eof, hit_eof)
601 :
602 : use ice_gather_scatter, only: scatter_global_ext
603 :
604 : integer (kind=int_kind), intent(in) :: &
605 : nu , & ! unit number ! LCOV_EXCL_LINE
606 : nrec ! record number (0 for sequential access)
607 :
608 : real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(out) :: &
609 : work ! output array (real, 8-byte)
610 :
611 : character (len=4), intent(in) :: &
612 : atype ! format for input array
613 : ! (real/integer, 4-byte/8-byte)
614 :
615 : logical (kind=log_kind), intent(in) :: &
616 : diag ! if true, write diagnostic output
617 :
618 : logical (kind=log_kind), optional, intent(in) :: ignore_eof
619 : logical (kind=log_kind), optional, intent(out) :: hit_eof
620 :
621 : ! local variables
622 :
623 : integer (kind=int_kind) :: i, j, ios, nx, ny
624 :
625 : real (kind=dbl_kind) :: &
626 0 : amin, amax, asum ! min, max values and sum of input array
627 :
628 : logical (kind=log_kind) :: ignore_eof_use
629 :
630 : real (kind=dbl_kind), dimension(:,:), allocatable :: &
631 0 : work_g1
632 :
633 : real (kind=real_kind), dimension(:,:), allocatable :: &
634 0 : work_gr
635 :
636 : integer(kind=int_kind), dimension(:,:), allocatable :: &
637 0 : work_gi4
638 :
639 : integer(selected_int_kind(13)), dimension(:,:), allocatable :: &
640 0 : work_gi8
641 :
642 : character(len=*), parameter :: subname = '(ice_read_ext)'
643 :
644 0 : nx = nx_global + 2*nghost
645 0 : ny = ny_global + 2*nghost
646 :
647 0 : if (my_task == master_task) then
648 0 : allocate(work_g1(nx,ny))
649 : else
650 0 : allocate(work_g1(1,1)) ! to save memory
651 : endif
652 :
653 0 : if (my_task == master_task) then
654 :
655 : !-------------------------------------------------------------------
656 : ! Read global array according to format atype
657 : !-------------------------------------------------------------------
658 0 : if (present(hit_eof)) hit_eof = .false.
659 :
660 0 : if (atype == 'ida4') then
661 0 : allocate(work_gi4(nx,ny))
662 0 : read(nu,rec=nrec) work_gi4
663 0 : work_g1 = real(work_gi4,kind=dbl_kind)
664 0 : deallocate(work_gi4)
665 0 : elseif (atype == 'ida8') then
666 0 : allocate(work_gi8(nx,ny))
667 0 : read(nu,rec=nrec) work_gi8
668 0 : work_g1 = real(work_gi8,kind=dbl_kind)
669 0 : deallocate(work_gi8)
670 0 : elseif (atype == 'rda4') then
671 0 : allocate(work_gr(nx,ny))
672 0 : read(nu,rec=nrec) work_gr
673 0 : work_g1 = work_gr
674 0 : deallocate(work_gr)
675 0 : elseif (atype == 'rda8') then
676 0 : read(nu,rec=nrec) work_g1
677 0 : elseif (atype == 'ruf8') then
678 0 : if (present(ignore_eof)) then
679 0 : ignore_eof_use = ignore_eof
680 : else
681 0 : ignore_eof_use = .false.
682 : endif
683 0 : if (ignore_eof_use) then
684 : ! Read line from file, checking for end-of-file
685 0 : read(nu, iostat=ios) ((work_g1(i,j),i=1,nx), &
686 0 : j=1,ny)
687 0 : if (present(hit_eof)) hit_eof = ios < 0
688 : else
689 0 : read(nu) ((work_g1(i,j),i=1,nx),j=1,ny)
690 : endif
691 : else
692 0 : write(nu_diag,*) subname,' ERROR: reading unknown atype ',atype
693 : endif
694 : endif ! my_task = master_task
695 :
696 0 : if (present(hit_eof)) then
697 0 : call broadcast_scalar(hit_eof,master_task)
698 0 : if (hit_eof) then
699 0 : deallocate(work_g1)
700 0 : return
701 : endif
702 : endif
703 :
704 : !-------------------------------------------------------------------
705 : ! optional diagnostics
706 : !-------------------------------------------------------------------
707 0 : if (my_task==master_task .and. diag) then
708 0 : amin = minval(work_g1)
709 0 : amax = maxval(work_g1, mask = work_g1 /= spval_dbl)
710 0 : asum = sum (work_g1, mask = work_g1 /= spval_dbl)
711 0 : write(nu_diag,*) subname,' read_global ',nu, nrec, amin, amax, asum
712 : endif
713 :
714 : !-------------------------------------------------------------------
715 : ! Scatter data to individual processors.
716 : ! NOTE: Ghost cells are always updated
717 : !-------------------------------------------------------------------
718 :
719 0 : call scatter_global_ext(work, work_g1, master_task, distrb_info)
720 :
721 0 : deallocate(work_g1)
722 :
723 0 : end subroutine ice_read_ext
724 :
725 : !=======================================================================
726 :
727 : ! Writes an unformatted file
728 : ! work is a real array, atype indicates the format of the data
729 :
730 0 : subroutine ice_write_xyt(nu, nrec, work, atype, diag)
731 :
732 : use ice_gather_scatter, only: gather_global
733 :
734 : integer (kind=int_kind), intent(in) :: &
735 : nu , & ! unit number ! LCOV_EXCL_LINE
736 : nrec ! record number (0 for sequential access)
737 :
738 : real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(in) :: &
739 : work ! input array (real, 8-byte)
740 :
741 : character (len=4), intent(in) :: &
742 : atype ! format for output array
743 : ! (real/integer, 4-byte/8-byte)
744 :
745 : logical (kind=log_kind), intent(in) :: &
746 : diag ! if true, write diagnostic output
747 :
748 : ! local variables
749 :
750 : integer (kind=int_kind) :: i, j
751 :
752 : real (kind=dbl_kind) :: &
753 0 : amin, amax, asum ! min, max values and sum of input array
754 :
755 : real (kind=dbl_kind), dimension(:,:), allocatable :: &
756 0 : work_g1
757 :
758 : real (kind=real_kind), dimension(:,:), allocatable :: &
759 0 : work_gr
760 :
761 : integer(kind=int_kind), dimension(:,:), allocatable :: &
762 0 : work_gi4
763 :
764 : integer(selected_int_kind(13)), dimension(:,:), allocatable :: &
765 0 : work_gi8
766 :
767 : character(len=*), parameter :: subname = '(ice_write_xyt)'
768 :
769 : !-------------------------------------------------------------------
770 : ! Gather data from individual processors
771 : !-------------------------------------------------------------------
772 :
773 0 : if (my_task == master_task) then
774 0 : allocate(work_g1(nx_global,ny_global))
775 : else
776 0 : allocate(work_g1(1,1)) ! to save memory
777 : endif
778 :
779 0 : call gather_global(work_g1, work, master_task, distrb_info, spc_val=c0)
780 :
781 0 : if (my_task == master_task) then
782 :
783 : !-------------------------------------------------------------------
784 : ! Write global array according to format atype
785 : !-------------------------------------------------------------------
786 0 : if (atype == 'ida4') then
787 0 : allocate(work_gi4(nx_global,ny_global))
788 0 : work_gi4 = nint(work_g1)
789 0 : write(nu,rec=nrec) work_gi4
790 0 : deallocate(work_gi4)
791 0 : elseif (atype == 'ida8') then
792 0 : allocate(work_gi8(nx_global,ny_global))
793 0 : work_gi8 = nint(work_g1)
794 0 : write(nu,rec=nrec) work_gi8
795 0 : deallocate(work_gi8)
796 0 : elseif (atype == 'rda4') then
797 0 : allocate(work_gr(nx_global,ny_global))
798 0 : work_gr = real(work_g1,real_kind)
799 0 : write(nu,rec=nrec) work_gr
800 0 : deallocate(work_gr)
801 0 : elseif (atype == 'rda8') then
802 0 : write(nu,rec=nrec) work_g1
803 0 : elseif (atype == 'ruf8') then
804 0 : write(nu) ((work_g1(i,j),i=1,nx_global),j=1,ny_global)
805 : else
806 0 : write(nu_diag,*) subname,' ERROR: writing unknown atype ',atype
807 : endif
808 :
809 : !-------------------------------------------------------------------
810 : ! diagnostics
811 : !-------------------------------------------------------------------
812 0 : if (diag) then
813 0 : amin = minval(work_g1)
814 0 : amax = maxval(work_g1, mask = work_g1 /= spval_dbl)
815 0 : asum = sum (work_g1, mask = work_g1 /= spval_dbl)
816 0 : write(nu_diag,*) subname,' write_global ', nu, nrec, amin, amax, asum
817 : endif
818 :
819 : endif ! my_task = master_task
820 :
821 0 : deallocate(work_g1)
822 :
823 0 : end subroutine ice_write_xyt
824 :
825 : !=======================================================================
826 :
827 : ! Writes an unformatted file
828 : ! work is a real array, atype indicates the format of the data
829 :
830 0 : subroutine ice_write_xyzt(nu, nrec, work, atype, diag)
831 :
832 : use ice_gather_scatter, only: gather_global
833 : use ice_domain_size, only: nblyr
834 :
835 : integer (kind=int_kind), intent(in) :: &
836 : nu , & ! unit number ! LCOV_EXCL_LINE
837 : nrec ! record number (0 for sequential access)
838 :
839 : real (kind=dbl_kind), dimension(nx_block,ny_block,nblyr+2,max_blocks), &
840 : intent(in) :: & ! LCOV_EXCL_LINE
841 : work ! input array (real, 8-byte)
842 :
843 : character (len=4), intent(in) :: &
844 : atype ! format for output array
845 : ! (real/integer, 4-byte/8-byte)
846 :
847 : logical (kind=log_kind), intent(in) :: &
848 : diag ! if true, write diagnostic output
849 :
850 : ! local variables
851 :
852 : integer (kind=int_kind) :: i, j, k
853 :
854 : real (kind=dbl_kind) :: &
855 0 : amin, amax, asum ! min, max values and sum of input array
856 :
857 : real (kind=dbl_kind), dimension(:,:,:), allocatable :: &
858 0 : work_g4
859 :
860 : real (kind=real_kind), dimension(:,:,:), allocatable :: &
861 0 : work_gr3
862 :
863 : integer(kind=int_kind), dimension(:,:,:), allocatable :: &
864 0 : work_gi5
865 :
866 : integer(selected_int_kind(13)), dimension(:,:,:), allocatable :: &
867 0 : work_gi9
868 :
869 : character(len=*), parameter :: subname = '(ice_write_xyzt)'
870 :
871 : !-------------------------------------------------------------------
872 : ! Gather data from individual processors
873 : !-------------------------------------------------------------------
874 :
875 0 : if (my_task == master_task) then
876 0 : allocate(work_g4(nx_global,ny_global,nblyr+2))
877 : else
878 0 : allocate(work_g4(1,1,nblyr+2)) ! to save memory
879 : endif
880 0 : do k = 1,nblyr+2
881 0 : call gather_global(work_g4(:,:,k), work(:,:,k,:), master_task, &
882 0 : distrb_info, spc_val=c0)
883 : enddo !k
884 :
885 0 : if (my_task == master_task) then
886 :
887 : !-------------------------------------------------------------------
888 : ! Write global array according to format atype
889 : !-------------------------------------------------------------------
890 0 : if (atype == 'ida4') then
891 0 : allocate(work_gi5(nx_global,ny_global,nblyr+2))
892 0 : work_gi5 = nint(work_g4)
893 0 : write(nu,rec=nrec) work_gi5
894 0 : deallocate(work_gi5)
895 0 : elseif (atype == 'ida8') then
896 0 : allocate(work_gi9(nx_global,ny_global,nblyr+2))
897 0 : work_gi9 = nint(work_g4)
898 0 : write(nu,rec=nrec) work_gi9
899 0 : deallocate(work_gi9)
900 0 : elseif (atype == 'rda4') then
901 0 : allocate(work_gr3(nx_global,ny_global,nblyr+2))
902 0 : work_gr3 = real(work_g4,real_kind)
903 0 : write(nu,rec=nrec) work_gr3
904 0 : deallocate(work_gr3)
905 0 : elseif (atype == 'rda8') then
906 0 : write(nu,rec=nrec) work_g4
907 0 : elseif (atype == 'ruf8') then
908 0 : write(nu)(((work_g4(i,j,k),i=1,nx_global),j=1,ny_global), &
909 0 : k=1,nblyr+2)
910 : else
911 0 : write(nu_diag,*) subname,' ERROR: writing unknown atype ',atype
912 : endif
913 :
914 : !-------------------------------------------------------------------
915 : ! diagnostics
916 : !-------------------------------------------------------------------
917 0 : if (diag) then
918 0 : amin = minval(work_g4)
919 0 : amax = maxval(work_g4, mask = work_g4 /= spval_dbl)
920 0 : asum = sum (work_g4, mask = work_g4 /= spval_dbl)
921 0 : write(nu_diag,*) subname,' write_global ', nu, nrec, amin, amax, asum
922 : endif
923 :
924 : endif ! my_task = master_task
925 :
926 0 : deallocate(work_g4)
927 :
928 0 : end subroutine ice_write_xyzt
929 :
930 : !=======================================================================
931 : !
932 : ! Writes an unformatted file, including ghost cells
933 : ! work is a real array, atype indicates the format of the data
934 : !
935 : ! author: Tony Craig, NCAR
936 :
937 0 : subroutine ice_write_ext(nu, nrec, work, atype, diag)
938 :
939 : use ice_gather_scatter, only: gather_global_ext
940 :
941 : integer (kind=int_kind), intent(in) :: &
942 : nu , & ! unit number ! LCOV_EXCL_LINE
943 : nrec ! record number (0 for sequential access)
944 :
945 : real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), &
946 : intent(in) :: & ! LCOV_EXCL_LINE
947 : work ! input array (real, 8-byte)
948 :
949 : character (len=4), intent(in) :: &
950 : atype ! format for output array
951 : ! (real/integer, 4-byte/8-byte)
952 :
953 : logical (kind=log_kind), intent(in) :: &
954 : diag ! if true, write diagnostic output
955 :
956 : ! local variables
957 :
958 : integer (kind=int_kind) :: i, j, nx, ny
959 :
960 : real (kind=dbl_kind) :: &
961 0 : amin, amax, asum ! min, max values and sum of input array
962 :
963 : real (kind=dbl_kind), dimension(:,:), allocatable :: &
964 0 : work_g1
965 :
966 : real (kind=real_kind), dimension(:,:), allocatable :: &
967 0 : work_gr
968 :
969 : integer(kind=int_kind), dimension(:,:), allocatable :: &
970 0 : work_gi4
971 :
972 : integer(selected_int_kind(13)), dimension(:,:), allocatable :: &
973 0 : work_gi8
974 :
975 : character(len=*), parameter :: subname = '(ice_write_ext)'
976 :
977 : !-------------------------------------------------------------------
978 : ! Gather data from individual processors
979 : !-------------------------------------------------------------------
980 :
981 0 : nx = nx_global + 2*nghost
982 0 : ny = ny_global + 2*nghost
983 :
984 0 : if (my_task == master_task) then
985 0 : allocate(work_g1(nx,ny))
986 : else
987 0 : allocate(work_g1(1,1)) ! to save memory
988 : endif
989 :
990 0 : call gather_global_ext(work_g1, work, master_task, distrb_info, spc_val=c0)
991 :
992 0 : if (my_task == master_task) then
993 :
994 : !-------------------------------------------------------------------
995 : ! Write global array according to format atype
996 : !-------------------------------------------------------------------
997 0 : if (atype == 'ida4') then
998 0 : allocate(work_gi4(nx,ny))
999 0 : work_gi4 = nint(work_g1)
1000 0 : write(nu,rec=nrec) work_gi4
1001 0 : deallocate(work_gi4)
1002 0 : elseif (atype == 'ida8') then
1003 0 : allocate(work_gi8(nx,ny))
1004 0 : work_gi8 = nint(work_g1)
1005 0 : write(nu,rec=nrec) work_gi8
1006 0 : deallocate(work_gi8)
1007 0 : elseif (atype == 'rda4') then
1008 0 : allocate(work_gr(nx,ny))
1009 0 : work_gr = real(work_g1,real_kind)
1010 0 : write(nu,rec=nrec) work_gr
1011 0 : deallocate(work_gr)
1012 0 : elseif (atype == 'rda8') then
1013 0 : write(nu,rec=nrec) work_g1
1014 0 : elseif (atype == 'ruf8') then
1015 0 : write(nu) ((work_g1(i,j),i=1,nx),j=1,ny)
1016 : else
1017 0 : write(nu_diag,*) subname,' ERROR: writing unknown atype ',atype
1018 : endif
1019 :
1020 : !-------------------------------------------------------------------
1021 : ! diagnostics
1022 : !-------------------------------------------------------------------
1023 0 : if (diag) then
1024 0 : amin = minval(work_g1)
1025 0 : amax = maxval(work_g1, mask = work_g1 /= spval_dbl)
1026 0 : asum = sum (work_g1, mask = work_g1 /= spval_dbl)
1027 0 : write(nu_diag,*) subname,' write_global ', nu, nrec, amin, amax, asum
1028 : endif
1029 :
1030 : endif ! my_task = master_task
1031 :
1032 0 : deallocate(work_g1)
1033 :
1034 0 : end subroutine ice_write_ext
1035 :
1036 : !=======================================================================
1037 :
1038 : ! Opens a netCDF file for reading
1039 : ! Adapted by Alison McLaren, Met Office from ice_open
1040 :
1041 2904 : subroutine ice_open_nc(filename, fid)
1042 :
1043 : character (char_len_long), intent(in) :: &
1044 : filename ! netCDF filename
1045 :
1046 : integer (kind=int_kind), intent(out) :: &
1047 : fid ! unit number
1048 :
1049 : ! local variables
1050 :
1051 : character(len=*), parameter :: subname = '(ice_open_nc)'
1052 :
1053 : #ifdef USE_NETCDF
1054 : integer (kind=int_kind) :: &
1055 : status ! status variable from netCDF routine
1056 :
1057 2904 : if (my_task == master_task) then
1058 :
1059 624 : status = nf90_open(filename, NF90_NOWRITE, fid)
1060 624 : if (status /= nf90_noerr) then
1061 : !write(nu_diag,*) subname,' NF90_STRERROR = ',trim(nf90_strerror(status))
1062 : call abort_ice(subname//' ERROR: Cannot open '//trim(filename), &
1063 0 : file=__FILE__, line=__LINE__)
1064 : endif
1065 :
1066 : endif ! my_task = master_task
1067 :
1068 : #else
1069 : call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined for '//trim(filename), &
1070 : file=__FILE__, line=__LINE__)
1071 : fid = -999 ! to satisfy intent(out) attribute
1072 : #endif
1073 2904 : end subroutine ice_open_nc
1074 :
1075 : !=======================================================================
1076 :
1077 : ! Read a netCDF file and scatter to processors.
1078 : ! If the optional variables field_loc and field_type are present,
1079 : ! the ghost cells are filled using values from the global array.
1080 : ! This prevents them from being filled with zeroes in land cells
1081 : ! (subroutine ice_HaloUpdate need not be called).
1082 : !
1083 : ! Adapted by Alison McLaren, Met Office from ice_read
1084 :
1085 7790 : subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, &
1086 : field_loc, field_type, restart_ext)
1087 :
1088 : use ice_gather_scatter, only: scatter_global, scatter_global_ext
1089 :
1090 : integer (kind=int_kind), intent(in) :: &
1091 : fid , & ! file id ! LCOV_EXCL_LINE
1092 : nrec ! record number
1093 :
1094 : logical (kind=log_kind), intent(in) :: &
1095 : diag ! if true, write diagnostic output
1096 :
1097 : character (len=*), intent(in) :: &
1098 : varname ! field name in netcdf file
1099 :
1100 : real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(out) :: &
1101 : work ! output array (real, 8-byte)
1102 :
1103 : logical (kind=log_kind), optional, intent(in) :: &
1104 : restart_ext ! if true, read extended grid
1105 :
1106 : integer (kind=int_kind), optional, intent(in) :: &
1107 : field_loc, & ! location of field on staggered grid ! LCOV_EXCL_LINE
1108 : field_type ! type of field (scalar, vector, angle)
1109 :
1110 : ! local variables
1111 :
1112 : character(len=*), parameter :: subname = '(ice_read_nc_xy)'
1113 :
1114 : #ifdef USE_NETCDF
1115 : ! netCDF file diagnostics:
1116 : integer (kind=int_kind) :: &
1117 : varid , & ! variable id ! LCOV_EXCL_LINE
1118 : status , & ! status output from netcdf routines ! LCOV_EXCL_LINE
1119 : ndims , & ! number of dimensions ! LCOV_EXCL_LINE
1120 : dimlen ! dimension size
1121 :
1122 : integer (kind=int_kind), dimension(10) :: &
1123 : dimids ! generic size dimids
1124 :
1125 : real (kind=dbl_kind) :: &
1126 : missingvalue, & ! LCOV_EXCL_LINE
1127 3672 : amin, amax, asum ! min, max values and sum of input array
1128 :
1129 : real (kind=dbl_kind), dimension(:,:), allocatable :: &
1130 7790 : work_g1
1131 :
1132 : integer (kind=int_kind) :: nx, ny
1133 :
1134 : integer (kind=int_kind) :: lnrec ! local value of nrec
1135 :
1136 : real (kind=dbl_kind), dimension(:,:), allocatable :: &
1137 7790 : work_g2
1138 :
1139 7790 : lnrec = nrec
1140 :
1141 7790 : if (orca_halogrid .and. .not. present(restart_ext)) then
1142 0 : if (my_task == master_task) then
1143 0 : allocate(work_g2(nx_global+2,ny_global+1))
1144 : else
1145 0 : allocate(work_g2(1,1)) ! to save memory
1146 : endif
1147 0 : work_g2(:,:) = c0
1148 : endif
1149 :
1150 7790 : nx = nx_global
1151 7790 : ny = ny_global
1152 :
1153 25165720 : work = c0 ! to satisfy intent(out) attribute
1154 :
1155 7790 : if (present(restart_ext)) then
1156 0 : if (restart_ext) then
1157 0 : nx = nx_global + 2*nghost
1158 0 : ny = ny_global + 2*nghost
1159 : endif
1160 : endif
1161 :
1162 7790 : if (my_task == master_task) then
1163 1674 : allocate(work_g1(nx,ny))
1164 : else
1165 6116 : allocate(work_g1(1,1)) ! to save memory
1166 : endif
1167 :
1168 7790 : if (my_task == master_task) then
1169 :
1170 : !-------------------------------------------------------------
1171 : ! Find out ID of required variable
1172 : !-------------------------------------------------------------
1173 :
1174 1674 : status = nf90_inq_varid(fid, trim(varname), varid)
1175 1674 : if (status /= nf90_noerr) then
1176 : call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), &
1177 0 : file=__FILE__, line=__LINE__)
1178 : endif
1179 :
1180 : !-------------------------------------------------------------
1181 : ! Check nrec axis size
1182 : !-------------------------------------------------------------
1183 :
1184 1674 : status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids)
1185 1674 : if (status /= nf90_noerr) then
1186 : call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), &
1187 0 : file=__FILE__, line=__LINE__)
1188 : endif
1189 1674 : if (ndims > 2) then
1190 1526 : status = nf90_inquire_dimension(fid, dimids(3), len=dimlen)
1191 1526 : if (status /= nf90_noerr) then
1192 : call abort_ice(subname//' ERROR: inquire dimension size 3 '//trim(varname), &
1193 0 : file=__FILE__, line=__LINE__)
1194 : endif
1195 1526 : if (lnrec > dimlen) then
1196 0 : write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen
1197 : call abort_ice(subname//' ERROR: not enough records '//trim(varname), &
1198 0 : file=__FILE__, line=__LINE__)
1199 : endif
1200 : endif
1201 :
1202 : !--------------------------------------------------------------
1203 : ! Read global array
1204 : !--------------------------------------------------------------
1205 :
1206 1674 : if (orca_halogrid .and. .not. present(restart_ext)) then
1207 : status = nf90_get_var( fid, varid, work_g2, &
1208 : start=(/1,1,lnrec/), & ! LCOV_EXCL_LINE
1209 0 : count=(/nx_global+2,ny_global+1,1/))
1210 0 : if (status /= nf90_noerr) then
1211 : call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), &
1212 0 : file=__FILE__, line=__LINE__)
1213 : endif
1214 0 : work_g1 = work_g2(2:nx_global+1,1:ny_global)
1215 : else
1216 : status = nf90_get_var( fid, varid, work_g1, &
1217 : start=(/1,1,lnrec/), & ! LCOV_EXCL_LINE
1218 11718 : count=(/nx,ny,1/))
1219 1674 : if (status /= nf90_noerr) then
1220 : call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), &
1221 0 : file=__FILE__, line=__LINE__)
1222 : endif
1223 : endif
1224 :
1225 1674 : status = nf90_get_att(fid, varid, "_FillValue", missingvalue)
1226 : endif ! my_task = master_task
1227 :
1228 : !-------------------------------------------------------------------
1229 : ! optional diagnostics
1230 : !-------------------------------------------------------------------
1231 :
1232 7790 : if (my_task==master_task .and. diag) then
1233 : write(nu_diag,'(2a,i8,a,i8,2a)') &
1234 : subname,' fid= ',fid, ', lnrec = ',lnrec, & ! LCOV_EXCL_LINE
1235 296 : ', varname = ',trim(varname)
1236 : ! status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar)
1237 : ! write(nu_diag,*) subname,' ndim= ',ndim,', nvar= ',nvar
1238 : ! do id=1,ndim
1239 : ! status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen)
1240 : ! write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen
1241 : ! enddo
1242 1858812 : amin = minval(work_g1)
1243 1858812 : amax = maxval(work_g1, mask = work_g1 /= missingvalue)
1244 1858812 : asum = sum (work_g1, mask = work_g1 /= missingvalue)
1245 148 : write(nu_diag,*) subname,' min, max, sum =', amin, amax, asum, trim(varname)
1246 : endif
1247 :
1248 : !-------------------------------------------------------------------
1249 : ! Scatter data to individual processors.
1250 : ! NOTE: Ghost cells are not updated unless field_loc is present.
1251 : !-------------------------------------------------------------------
1252 :
1253 7790 : if (present(restart_ext)) then
1254 0 : if (restart_ext) then
1255 0 : call scatter_global_ext(work, work_g1, master_task, distrb_info)
1256 : endif
1257 : else
1258 7790 : if (present(field_loc)) then
1259 0 : call scatter_global(work, work_g1, master_task, distrb_info, &
1260 7790 : field_loc, field_type)
1261 : else
1262 0 : call scatter_global(work, work_g1, master_task, distrb_info, &
1263 0 : field_loc_noupdate, field_type_noupdate)
1264 : endif
1265 : endif
1266 :
1267 7790 : deallocate(work_g1)
1268 :
1269 : ! echmod: this should not be necessary if fill/missing are only on land
1270 25165720 : where (work > 1.0e+30_dbl_kind) work = c0
1271 :
1272 7790 : if (orca_halogrid .and. .not. present(restart_ext)) deallocate(work_g2)
1273 :
1274 : #else
1275 : work = c0 ! to satisfy intent(out) attribute
1276 : call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', &
1277 : file=__FILE__, line=__LINE__)
1278 : #endif
1279 15580 : end subroutine ice_read_nc_xy
1280 :
1281 : !=======================================================================
1282 :
1283 : ! Read a netCDF file and scatter to processors.
1284 : ! If the optional variables field_loc and field_type are present,
1285 : ! the ghost cells are filled using values from the global array.
1286 : ! This prevents them from being filled with zeroes in land cells
1287 : ! (subroutine ice_HaloUpdate need not be called).
1288 : !
1289 : ! Adapted by David Bailey, NCAR from ice_read_nc_xy
1290 :
1291 659 : subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, &
1292 : field_loc, field_type, restart_ext)
1293 :
1294 : use ice_gather_scatter, only: scatter_global, scatter_global_ext
1295 :
1296 : integer (kind=int_kind), intent(in) :: &
1297 : fid , & ! file id ! LCOV_EXCL_LINE
1298 : nrec ! record number
1299 :
1300 : character (len=*), intent(in) :: &
1301 : varname ! field name in netcdf file
1302 :
1303 : logical (kind=log_kind), intent(in) :: &
1304 : diag ! if true, write diagnostic output
1305 :
1306 : real (kind=dbl_kind), dimension(nx_block,ny_block,ncat,max_blocks), intent(out) :: &
1307 : work ! output array (real, 8-byte)
1308 :
1309 : logical (kind=log_kind), optional, intent(in) :: &
1310 : restart_ext ! if true, read extended grid
1311 :
1312 : integer (kind=int_kind), optional, intent(in) :: &
1313 : field_loc, & ! location of field on staggered grid ! LCOV_EXCL_LINE
1314 : field_type ! type of field (scalar, vector, angle)
1315 :
1316 : ! local variables
1317 :
1318 : character(len=*), parameter :: subname = '(ice_read_nc_xyz)'
1319 :
1320 : #ifdef USE_NETCDF
1321 : ! netCDF file diagnostics:
1322 : integer (kind=int_kind) :: &
1323 : n, & ! ncat index ! LCOV_EXCL_LINE
1324 : varid , & ! variable id ! LCOV_EXCL_LINE
1325 : status , & ! status output from netcdf routines ! LCOV_EXCL_LINE
1326 : ndims , & ! number of dimensions ! LCOV_EXCL_LINE
1327 : dimlen ! dimension size
1328 :
1329 : integer (kind=int_kind), dimension(10) :: &
1330 : dimids ! generic size dimids
1331 :
1332 : real (kind=dbl_kind) :: &
1333 : missingvalue, & ! missing value ! LCOV_EXCL_LINE
1334 188 : amin, amax, asum ! min, max values and sum of input array
1335 :
1336 : ! character (char_len) :: &
1337 : ! dimname ! dimension name
1338 :
1339 : real (kind=dbl_kind), dimension(:,:,:), allocatable :: &
1340 659 : work_g1
1341 :
1342 : integer (kind=int_kind) :: nx, ny
1343 :
1344 : integer (kind=int_kind) :: lnrec ! local value of nrec
1345 :
1346 : real (kind=dbl_kind), dimension(:,:,:), allocatable :: &
1347 659 : work_g2
1348 :
1349 659 : lnrec = nrec
1350 :
1351 659 : if (orca_halogrid .and. .not. present(restart_ext)) then
1352 0 : if (my_task == master_task) then
1353 0 : allocate(work_g2(nx_global+2,ny_global+1,ncat))
1354 : else
1355 0 : allocate(work_g2(1,1,ncat)) ! to save memory
1356 : endif
1357 0 : work_g2(:,:,:) = c0
1358 : endif
1359 :
1360 659 : nx = nx_global
1361 659 : ny = ny_global
1362 :
1363 659 : if (present(restart_ext)) then
1364 0 : if (restart_ext) then
1365 0 : nx = nx_global + 2*nghost
1366 0 : ny = ny_global + 2*nghost
1367 : endif
1368 : endif
1369 :
1370 659 : if (my_task == master_task) then
1371 132 : allocate(work_g1(nx,ny,ncat))
1372 : else
1373 527 : allocate(work_g1(1,1,ncat)) ! to save memory
1374 : endif
1375 :
1376 659 : if (my_task == master_task) then
1377 :
1378 : !-------------------------------------------------------------
1379 : ! Find out ID of required variable
1380 : !-------------------------------------------------------------
1381 :
1382 132 : status = nf90_inq_varid(fid, trim(varname), varid)
1383 132 : if (status /= nf90_noerr) then
1384 : call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), &
1385 0 : file=__FILE__, line=__LINE__)
1386 : endif
1387 :
1388 : !-------------------------------------------------------------
1389 : ! Check nrec axis size
1390 : !-------------------------------------------------------------
1391 :
1392 132 : status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids)
1393 132 : if (status /= nf90_noerr) then
1394 : call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), &
1395 0 : file=__FILE__, line=__LINE__)
1396 : endif
1397 132 : if (ndims > 3) then
1398 0 : status = nf90_inquire_dimension(fid, dimids(4), len=dimlen)
1399 0 : if (status /= nf90_noerr) then
1400 : call abort_ice(subname//' ERROR: inquire dimension size 4 '//trim(varname), &
1401 0 : file=__FILE__, line=__LINE__)
1402 : endif
1403 0 : if (lnrec > dimlen) then
1404 0 : write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen
1405 : call abort_ice(subname//' ERROR: not enough records '//trim(varname), &
1406 0 : file=__FILE__, line=__LINE__)
1407 : endif
1408 : endif
1409 :
1410 : !--------------------------------------------------------------
1411 : ! Read global array
1412 : !--------------------------------------------------------------
1413 :
1414 132 : if (orca_halogrid .and. .not. present(restart_ext)) then
1415 : status = nf90_get_var( fid, varid, work_g2, &
1416 : start=(/1,1,1,lnrec/), & ! LCOV_EXCL_LINE
1417 0 : count=(/nx_global+2,ny_global+1,ncat,1/))
1418 0 : if (status /= nf90_noerr) then
1419 : call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), &
1420 0 : file=__FILE__, line=__LINE__)
1421 : endif
1422 0 : work_g1 = work_g2(2:nx_global+1,1:ny_global,:)
1423 : else
1424 : status = nf90_get_var( fid, varid, work_g1, &
1425 : start=(/1,1,1,lnrec/), & ! LCOV_EXCL_LINE
1426 1188 : count=(/nx,ny,ncat,1/))
1427 132 : if (status /= nf90_noerr) then
1428 : call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), &
1429 0 : file=__FILE__, line=__LINE__)
1430 : endif
1431 : endif
1432 :
1433 132 : status = nf90_get_att(fid, varid, "_FillValue", missingvalue)
1434 : endif ! my_task = master_task
1435 :
1436 : !-------------------------------------------------------------------
1437 : ! optional diagnostics
1438 : !-------------------------------------------------------------------
1439 :
1440 659 : if (my_task==master_task .and. diag) then
1441 : write(nu_diag,'(2a,i8,a,i8,2a)') &
1442 : subname,' fid= ',fid, ', lnrec = ',lnrec, & ! LCOV_EXCL_LINE
1443 264 : ', varname = ',trim(varname)
1444 : ! status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar)
1445 : ! write(nu_diag,*) subname,' ndim= ',ndim,', nvar= ',nvar
1446 : ! do id=1,ndim
1447 : ! status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen)
1448 : ! write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen
1449 : ! enddo
1450 792 : do n=1,ncat
1451 8404660 : amin = minval(work_g1(:,:,n))
1452 8404660 : amax = maxval(work_g1(:,:,n), mask = work_g1(:,:,n) /= missingvalue)
1453 8404660 : asum = sum (work_g1(:,:,n), mask = work_g1(:,:,n) /= missingvalue)
1454 792 : write(nu_diag,*) subname,' min, max, sum =', amin, amax, asum, trim(varname)
1455 : enddo
1456 : endif
1457 :
1458 : !-------------------------------------------------------------------
1459 : ! Scatter data to individual processors.
1460 : ! NOTE: Ghost cells are not updated unless field_loc is present.
1461 : !-------------------------------------------------------------------
1462 :
1463 659 : if (present(restart_ext)) then
1464 0 : if (restart_ext) then
1465 0 : do n=1,ncat
1466 0 : call scatter_global_ext(work(:,:,n,:), work_g1(:,:,n), &
1467 0 : master_task, distrb_info)
1468 : enddo
1469 : endif
1470 : else
1471 659 : if (present(field_loc)) then
1472 3954 : do n=1,ncat
1473 0 : call scatter_global(work(:,:,n,:), work_g1(:,:,n), master_task, &
1474 3954 : distrb_info, field_loc, field_type)
1475 : enddo
1476 : else
1477 0 : do n=1,ncat
1478 0 : call scatter_global(work(:,:,n,:), work_g1(:,:,n), master_task, &
1479 0 : distrb_info, field_loc_noupdate, field_type_noupdate)
1480 : enddo
1481 : endif
1482 : endif
1483 :
1484 659 : deallocate(work_g1)
1485 659 : if (orca_halogrid .and. .not. present(restart_ext)) deallocate(work_g2)
1486 :
1487 : #else
1488 : call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', &
1489 : file=__FILE__, line=__LINE__)
1490 : work = c0 ! to satisfy intent(out) attribute
1491 : #endif
1492 1318 : end subroutine ice_read_nc_xyz
1493 :
1494 : !=======================================================================
1495 :
1496 : ! Read a netCDF file and scatter to processors.
1497 : ! If the optional variables field_loc and field_type are present,
1498 : ! the ghost cells are filled using values from the global array.
1499 : ! This prevents them from being filled with zeroes in land cells
1500 : ! (subroutine ice_HaloUpdate need not be called).
1501 : !
1502 : ! Adapted by David Bailey, NCAR from ice_read_nc_xy
1503 : ! Adapted by Lettie Roach, NIWA to read nfreq
1504 : ! by changing all occurrences of ncat to nfreq
1505 :
1506 0 : subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, &
1507 : field_loc, field_type, restart_ext)
1508 :
1509 : use ice_fileunits, only: nu_diag
1510 : use ice_domain_size, only: nfreq
1511 : use ice_gather_scatter, only: scatter_global, scatter_global_ext
1512 :
1513 : integer (kind=int_kind), intent(in) :: &
1514 : fid , & ! file id ! LCOV_EXCL_LINE
1515 : nrec ! record number
1516 :
1517 : character (len=*), intent(in) :: &
1518 : varname ! field name in netcdf file
1519 :
1520 : logical (kind=log_kind), intent(in) :: &
1521 : diag ! if true, write diagnostic output
1522 :
1523 : real (kind=dbl_kind), dimension(nx_block,ny_block,nfreq,1,max_blocks), &
1524 : intent(out) :: & ! LCOV_EXCL_LINE
1525 : work ! output array (real, 8-byte)
1526 :
1527 : logical (kind=log_kind), optional, intent(in) :: &
1528 : restart_ext ! if true, read extended grid
1529 :
1530 : integer (kind=int_kind), optional, intent(in) :: &
1531 : field_loc, & ! location of field on staggered grid ! LCOV_EXCL_LINE
1532 : field_type ! type of field (scalar, vector, angle)
1533 :
1534 : ! local variables
1535 :
1536 : ! netCDF file diagnostics:
1537 : integer (kind=int_kind) :: &
1538 : varid, & ! variable id ! LCOV_EXCL_LINE
1539 : status, & ! status output from netcdf routines ! LCOV_EXCL_LINE
1540 : ndim, nvar, & ! sizes of netcdf file ! LCOV_EXCL_LINE
1541 : id, & ! dimension index ! LCOV_EXCL_LINE
1542 : n, & ! ncat index ! LCOV_EXCL_LINE
1543 : ndims, & ! number of dimensions ! LCOV_EXCL_LINE
1544 : dimlen ! dimension size
1545 :
1546 : integer (kind=int_kind), dimension(10) :: &
1547 : dimids ! generic size dimids
1548 :
1549 : real (kind=dbl_kind) :: &
1550 : missingvalue, & ! missing value ! LCOV_EXCL_LINE
1551 0 : amin, amax, asum ! min, max values and sum of input array
1552 :
1553 : character (char_len) :: &
1554 : dimname ! dimension name
1555 :
1556 : real (kind=dbl_kind), dimension(:,:,:), allocatable :: &
1557 0 : work_g1
1558 :
1559 : integer (kind=int_kind) :: nx, ny
1560 :
1561 : integer (kind=int_kind) :: lnrec ! local value of nrec
1562 :
1563 : character(len=*), parameter :: subname = '(ice_read_nc_xyf)'
1564 :
1565 : #ifdef USE_NETCDF
1566 : real (kind=dbl_kind), dimension(:,:,:), allocatable :: &
1567 0 : work_g2
1568 :
1569 0 : lnrec = nrec
1570 :
1571 0 : if (orca_halogrid .and. .not. present(restart_ext)) then
1572 0 : if (my_task == master_task) then
1573 0 : allocate(work_g2(nx_global+2,ny_global+1,nfreq))
1574 : else
1575 0 : allocate(work_g2(1,1,nfreq)) ! to save memory
1576 : endif
1577 0 : work_g2(:,:,:) = c0
1578 : endif
1579 :
1580 0 : nx = nx_global
1581 0 : ny = ny_global
1582 :
1583 0 : if (present(restart_ext)) then
1584 0 : if (restart_ext) then
1585 0 : nx = nx_global + 2*nghost
1586 0 : ny = ny_global + 2*nghost
1587 : endif
1588 : endif
1589 :
1590 0 : if (my_task == master_task) then
1591 0 : allocate(work_g1(nx,ny,nfreq))
1592 : else
1593 0 : allocate(work_g1(1,1,nfreq)) ! to save memory
1594 : endif
1595 :
1596 0 : if (my_task == master_task) then
1597 :
1598 : !-------------------------------------------------------------
1599 : ! Find out ID of required variable
1600 : !-------------------------------------------------------------
1601 :
1602 0 : status = nf90_inq_varid(fid, trim(varname), varid)
1603 0 : if (status /= nf90_noerr) then
1604 : call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), &
1605 0 : file=__FILE__, line=__LINE__)
1606 : endif
1607 :
1608 : !-------------------------------------------------------------
1609 : ! Check nrec axis size
1610 : !-------------------------------------------------------------
1611 :
1612 0 : status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids)
1613 0 : if (status /= nf90_noerr) then
1614 : call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), &
1615 0 : file=__FILE__, line=__LINE__)
1616 : endif
1617 0 : if (ndims > 3) then
1618 0 : status = nf90_inquire_dimension(fid, dimids(4), len=dimlen)
1619 0 : if (status /= nf90_noerr) then
1620 : call abort_ice(subname//' ERROR: inquire dimension size 4 '//trim(varname), &
1621 0 : file=__FILE__, line=__LINE__)
1622 : endif
1623 0 : if (lnrec > dimlen) then
1624 0 : write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen
1625 : call abort_ice(subname//' ERROR: not enough records '//trim(varname), &
1626 0 : file=__FILE__, line=__LINE__)
1627 : endif
1628 : endif
1629 :
1630 : !--------------------------------------------------------------
1631 : ! Read global array
1632 : !--------------------------------------------------------------
1633 :
1634 0 : if (orca_halogrid .and. .not. present(restart_ext)) then
1635 : status = nf90_get_var( fid, varid, work_g2, &
1636 : start=(/1,1,1,lnrec/), & ! LCOV_EXCL_LINE
1637 0 : count=(/nx_global+2,ny_global+1,nfreq,1/))
1638 0 : if (status /= nf90_noerr) then
1639 : call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), &
1640 0 : file=__FILE__, line=__LINE__)
1641 : endif
1642 0 : work_g1 = work_g2(2:nx_global+1,1:ny_global,:)
1643 : else
1644 : status = nf90_get_var( fid, varid, work_g1, &
1645 : start=(/1,1,1,lnrec/), & ! LCOV_EXCL_LINE
1646 0 : count=(/nx,ny,nfreq,1/))
1647 0 : if (status /= nf90_noerr) then
1648 : call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), &
1649 0 : file=__FILE__, line=__LINE__)
1650 : endif
1651 : endif
1652 :
1653 0 : status = nf90_get_att(fid, varid, "missing_value", missingvalue)
1654 : endif ! my_task = master_task
1655 :
1656 : !-------------------------------------------------------------------
1657 : ! optional diagnostics
1658 : !-------------------------------------------------------------------
1659 :
1660 0 : if (my_task==master_task .and. diag) then
1661 : write(nu_diag,'(2a,i8,a,i8,2a)') &
1662 : subname,' fid= ',fid, ', lnrec = ',lnrec, & ! LCOV_EXCL_LINE
1663 0 : ', varname = ',trim(varname)
1664 0 : status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar)
1665 0 : write(nu_diag,*) subname,' ndim= ',ndim,', nvar= ',nvar
1666 0 : do id=1,ndim
1667 0 : status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen)
1668 0 : write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen
1669 : enddo
1670 0 : write(nu_diag,*) subname,' missingvalue= ',missingvalue
1671 0 : do n = 1, nfreq
1672 0 : amin = minval(work_g1(:,:,n))
1673 0 : amax = maxval(work_g1(:,:,n), mask = work_g1(:,:,n) /= missingvalue)
1674 0 : asum = sum (work_g1(:,:,n), mask = work_g1(:,:,n) /= missingvalue)
1675 0 : write(nu_diag,*) subname,' min, max, sum =', amin, amax, asum, trim(varname)
1676 : enddo
1677 : endif
1678 :
1679 : !-------------------------------------------------------------------
1680 : ! Scatter data to individual processors.
1681 : ! NOTE: Ghost cells are not updated unless field_loc is present.
1682 : !-------------------------------------------------------------------
1683 :
1684 0 : if (present(restart_ext)) then
1685 0 : if (restart_ext) then
1686 0 : do n = 1, nfreq
1687 0 : call scatter_global_ext(work(:,:,n,1,:), work_g1(:,:,n), &
1688 0 : master_task, distrb_info)
1689 : enddo
1690 : endif
1691 : else
1692 0 : if (present(field_loc)) then
1693 0 : do n = 1, nfreq
1694 0 : call scatter_global(work(:,:,n,1,:), work_g1(:,:,n), master_task, &
1695 0 : distrb_info, field_loc, field_type)
1696 : enddo
1697 : else
1698 0 : do n = 1, nfreq
1699 0 : call scatter_global(work(:,:,n,1,:), work_g1(:,:,n), master_task, &
1700 0 : distrb_info, field_loc_noupdate, field_type_noupdate)
1701 : enddo
1702 : endif
1703 : endif
1704 :
1705 : ! echmod: this should not be necessary if fill/missing are only on land
1706 0 : where (work > 1.0e+30_dbl_kind) work = c0
1707 :
1708 0 : deallocate(work_g1)
1709 0 : if (orca_halogrid .and. .not. present(restart_ext)) deallocate(work_g2)
1710 :
1711 : #else
1712 : call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', &
1713 : file=__FILE__, line=__LINE__)
1714 : work = c0 ! to satisfy intent(out) attribute
1715 : #endif
1716 :
1717 0 : end subroutine ice_read_nc_xyf
1718 :
1719 : !=======================================================================
1720 :
1721 : ! Read a netCDF file
1722 : ! Adapted by Alison McLaren, Met Office from ice_read
1723 :
1724 0 : subroutine ice_read_nc_point(fid, nrec, varname, work, diag, &
1725 : field_loc, field_type)
1726 :
1727 : integer (kind=int_kind), intent(in) :: &
1728 : fid , & ! file id ! LCOV_EXCL_LINE
1729 : nrec ! record number
1730 :
1731 : logical (kind=log_kind), intent(in) :: &
1732 : diag ! if true, write diagnostic output
1733 :
1734 : character (char_len), intent(in) :: &
1735 : varname ! field name in netcdf file
1736 :
1737 : integer (kind=int_kind), optional, intent(in) :: &
1738 : field_loc, & ! location of field on staggered grid ! LCOV_EXCL_LINE
1739 : field_type ! type of field (scalar, vector, angle)
1740 :
1741 : real (kind=dbl_kind), intent(out) :: &
1742 : work ! output variable (real, 8-byte)
1743 :
1744 : ! local variables
1745 :
1746 : character(len=*), parameter :: subname = '(ice_read_nc_point)'
1747 :
1748 : #ifdef USE_NETCDF
1749 : ! netCDF file diagnostics:
1750 : integer (kind=int_kind) :: &
1751 : varid, & ! netcdf id for field ! LCOV_EXCL_LINE
1752 : status, & ! status output from netcdf routines ! LCOV_EXCL_LINE
1753 : ndim, nvar, & ! sizes of netcdf file ! LCOV_EXCL_LINE
1754 : id, & ! dimension index ! LCOV_EXCL_LINE
1755 : ndims, & ! number of dimensions ! LCOV_EXCL_LINE
1756 : dimlen ! dimension size
1757 :
1758 : integer (kind=int_kind), dimension(10) :: &
1759 : dimids ! generic size dimids
1760 :
1761 : real (kind=dbl_kind), dimension(1) :: &
1762 0 : workg ! temporary work variable
1763 :
1764 : integer (kind=int_kind) :: lnrec ! local value of nrec
1765 :
1766 : character (char_len) :: &
1767 : dimname ! dimension name
1768 :
1769 0 : lnrec = nrec
1770 :
1771 0 : if (my_task == master_task) then
1772 :
1773 : !-------------------------------------------------------------
1774 : ! Find out ID of required variable
1775 : !-------------------------------------------------------------
1776 :
1777 0 : status = nf90_inq_varid(fid, trim(varname), varid)
1778 0 : if (status /= nf90_noerr) then
1779 : call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), &
1780 0 : file=__FILE__, line=__LINE__)
1781 : endif
1782 :
1783 : !-------------------------------------------------------------
1784 : ! Check nrec axis size
1785 : !-------------------------------------------------------------
1786 :
1787 0 : status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids)
1788 0 : if (status /= nf90_noerr) then
1789 : call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), &
1790 0 : file=__FILE__, line=__LINE__)
1791 : endif
1792 0 : if (ndims > 0) then
1793 0 : status = nf90_inquire_dimension(fid, dimids(1), len=dimlen)
1794 0 : if (status /= nf90_noerr) then
1795 : call abort_ice(subname//' ERROR: inquire dimension size 1 '//trim(varname), &
1796 0 : file=__FILE__, line=__LINE__)
1797 : endif
1798 0 : if (lnrec > dimlen) then
1799 0 : write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen
1800 : call abort_ice(subname//' ERROR: not enough records '//trim(varname), &
1801 0 : file=__FILE__, line=__LINE__)
1802 : endif
1803 : endif
1804 :
1805 : !--------------------------------------------------------------
1806 : ! Read point variable
1807 : !--------------------------------------------------------------
1808 :
1809 : status = nf90_get_var(fid, varid, workg, &
1810 : start= (/ lnrec /), & ! LCOV_EXCL_LINE
1811 0 : count=(/ 1 /))
1812 0 : if (status /= nf90_noerr) then
1813 : call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), &
1814 0 : file=__FILE__, line=__LINE__)
1815 : endif
1816 : endif ! my_task = master_task
1817 :
1818 : !-------------------------------------------------------------------
1819 : ! optional diagnostics
1820 : !-------------------------------------------------------------------
1821 :
1822 0 : if (my_task==master_task .and. diag) then
1823 : write(nu_diag,'(2a,i8,a,i8,2a)') &
1824 : subname,' fid= ',fid, ', lnrec = ',lnrec, & ! LCOV_EXCL_LINE
1825 0 : ', varname = ',trim(varname)
1826 0 : status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar)
1827 0 : write(nu_diag,*) subname,' ndim= ',ndim,', nvar= ',nvar
1828 0 : do id=1,ndim
1829 0 : status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen)
1830 0 : write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen
1831 : enddo
1832 : endif
1833 :
1834 0 : work = workg(1)
1835 :
1836 : #else
1837 : call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', &
1838 : file=__FILE__, line=__LINE__)
1839 : work = c0 ! to satisfy intent(out) attribute
1840 : #endif
1841 0 : end subroutine ice_read_nc_point
1842 :
1843 : !=======================================================================
1844 :
1845 : ! Written by T. Craig
1846 :
1847 0 : subroutine ice_read_nc_1D(fid, varname, work, diag, &
1848 : xdim)
1849 :
1850 : use ice_fileunits, only: nu_diag
1851 :
1852 : integer (kind=int_kind), intent(in) :: &
1853 : fid , & ! file id ! LCOV_EXCL_LINE
1854 : xdim ! field dimensions
1855 :
1856 : logical (kind=log_kind), intent(in) :: &
1857 : diag ! if true, write diagnostic output
1858 :
1859 : character (char_len), intent(in) :: &
1860 : varname ! field name in netcdf file
1861 :
1862 : real (kind=dbl_kind), dimension(:), intent(out) :: &
1863 : work ! output array
1864 :
1865 : ! local variables
1866 :
1867 : character(len=*), parameter :: subname = '(ice_read_nc_1D)'
1868 :
1869 : #ifdef USE_NETCDF
1870 : ! netCDF file diagnostics:
1871 : integer (kind=int_kind) :: &
1872 : varid, & ! netcdf id for field ! LCOV_EXCL_LINE
1873 : status, & ! status output from netcdf routines ! LCOV_EXCL_LINE
1874 : ndim, nvar ! sizes of netcdf file
1875 :
1876 : real (kind=dbl_kind), dimension(xdim) :: &
1877 0 : workg ! output array (real, 8-byte)
1878 :
1879 : !--------------------------------------------------------------
1880 :
1881 0 : if (my_task == master_task) then
1882 :
1883 0 : if (size(work,dim=1) < xdim) then
1884 0 : write(nu_diag,*) subname,' work, dim=1 ',size(work,dim=1),xdim
1885 : call abort_ice (subname//' ERROR: work array wrong size '//trim(varname), &
1886 0 : file=__FILE__, line=__LINE__ )
1887 : endif
1888 : !-------------------------------------------------------------
1889 : ! Find out ID of required variable
1890 : !-------------------------------------------------------------
1891 :
1892 0 : status = nf90_inq_varid(fid, trim(varname), varid)
1893 :
1894 0 : if (status /= nf90_noerr) then
1895 : call abort_ice (subname//' ERROR: Cannot find variable '//trim(varname), &
1896 0 : file=__FILE__, line=__LINE__ )
1897 : endif
1898 :
1899 : !--------------------------------------------------------------
1900 : ! Read array
1901 : !--------------------------------------------------------------
1902 0 : status = nf90_get_var( fid, varid, workg, &
1903 : start=(/1/), & ! LCOV_EXCL_LINE
1904 0 : count=(/xdim/) )
1905 0 : work(1:xdim) = workg(1:xdim)
1906 :
1907 : !-------------------------------------------------------------------
1908 : ! optional diagnostics
1909 : !-------------------------------------------------------------------
1910 :
1911 0 : if (diag) then
1912 0 : write(nu_diag,*) subname, &
1913 : ' fid= ',fid, ', xdim = ',xdim, & ! LCOV_EXCL_LINE
1914 0 : ' varname = ',trim(varname)
1915 0 : status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar)
1916 0 : write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar
1917 : endif
1918 : endif
1919 : #else
1920 : call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', &
1921 : file=__FILE__, line=__LINE__)
1922 : work = c0 ! to satisfy intent(out) attribute
1923 : #endif
1924 :
1925 0 : end subroutine ice_read_nc_1D
1926 :
1927 : !=======================================================================
1928 :
1929 : ! Written by T. Craig
1930 :
1931 0 : subroutine ice_read_nc_2D(fid, varname, work, diag, &
1932 : xdim, ydim)
1933 :
1934 : use ice_fileunits, only: nu_diag
1935 :
1936 : integer (kind=int_kind), intent(in) :: &
1937 : fid , & ! file id ! LCOV_EXCL_LINE
1938 : xdim, ydim ! field dimensions
1939 :
1940 : logical (kind=log_kind), intent(in) :: &
1941 : diag ! if true, write diagnostic output
1942 :
1943 : character (char_len), intent(in) :: &
1944 : varname ! field name in netcdf file
1945 :
1946 : real (kind=dbl_kind), dimension(:,:), intent(out) :: &
1947 : work ! output array
1948 :
1949 : ! local variables
1950 :
1951 : character(len=*), parameter :: subname = '(ice_read_nc_2D)'
1952 :
1953 : #ifdef USE_NETCDF
1954 : ! netCDF file diagnostics:
1955 : integer (kind=int_kind) :: &
1956 : varid, & ! netcdf id for field ! LCOV_EXCL_LINE
1957 : status, & ! status output from netcdf routines ! LCOV_EXCL_LINE
1958 : ndim, nvar ! sizes of netcdf file
1959 :
1960 : real (kind=dbl_kind), dimension(xdim,ydim) :: &
1961 0 : workg ! output array (real, 8-byte)
1962 :
1963 : !--------------------------------------------------------------
1964 :
1965 0 : if (my_task == master_task) then
1966 :
1967 0 : if (size(work,dim=1) < xdim .or. &
1968 0 : size(work,dim=2) < ydim) then
1969 0 : write(nu_diag,*) subname,' work, dim=1 ',size(work,dim=1),xdim
1970 0 : write(nu_diag,*) subname,' work, dim=2 ',size(work,dim=2),ydim
1971 : call abort_ice (subname//' ERROR: work array wrong size '//trim(varname), &
1972 0 : file=__FILE__, line=__LINE__ )
1973 : endif
1974 : !-------------------------------------------------------------
1975 : ! Find out ID of required variable
1976 : !-------------------------------------------------------------
1977 :
1978 0 : status = nf90_inq_varid(fid, trim(varname), varid)
1979 :
1980 0 : if (status /= nf90_noerr) then
1981 : call abort_ice (subname//' ERROR: Cannot find variable '//trim(varname), &
1982 0 : file=__FILE__, line=__LINE__ )
1983 : endif
1984 :
1985 : !--------------------------------------------------------------
1986 : ! Read array
1987 : !--------------------------------------------------------------
1988 0 : status = nf90_get_var( fid, varid, workg, &
1989 : start=(/1,1/), & ! LCOV_EXCL_LINE
1990 0 : count=(/xdim,ydim/) )
1991 0 : work(1:xdim,1:ydim) = workg(1:xdim, 1:ydim)
1992 :
1993 : !-------------------------------------------------------------------
1994 : ! optional diagnostics
1995 : !-------------------------------------------------------------------
1996 :
1997 0 : if (diag) then
1998 0 : write(nu_diag,*) subname, &
1999 : ' fid= ',fid, ', xdim = ',xdim, & ! LCOV_EXCL_LINE
2000 0 : ' ydim= ', ydim, ' varname = ',trim(varname)
2001 0 : status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar)
2002 0 : write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar
2003 : endif
2004 : endif
2005 : #else
2006 : call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', &
2007 : file=__FILE__, line=__LINE__)
2008 : work = c0 ! to satisfy intent(out) attribute
2009 : #endif
2010 :
2011 0 : end subroutine ice_read_nc_2D
2012 :
2013 : !=======================================================================
2014 : !=======================================================================
2015 :
2016 : ! Written by T. Craig
2017 :
2018 0 : subroutine ice_read_nc_3D(fid, varname, work, diag, &
2019 : xdim, ydim, zdim)
2020 :
2021 : use ice_fileunits, only: nu_diag
2022 :
2023 : integer (kind=int_kind), intent(in) :: &
2024 : fid , & ! file id ! LCOV_EXCL_LINE
2025 : xdim, ydim,zdim ! field dimensions
2026 :
2027 : logical (kind=log_kind), intent(in) :: &
2028 : diag ! if true, write diagnostic output
2029 :
2030 : character (char_len), intent(in) :: &
2031 : varname ! field name in netcdf file
2032 :
2033 : real (kind=dbl_kind), dimension(:,:,:), intent(out) :: &
2034 : work ! output array
2035 :
2036 : ! local variables
2037 :
2038 : character(len=*), parameter :: subname = '(ice_read_nc_3D)'
2039 :
2040 : #ifdef USE_NETCDF
2041 : ! netCDF file diagnostics:
2042 : integer (kind=int_kind) :: &
2043 : varid, & ! netcdf id for field ! LCOV_EXCL_LINE
2044 : status, & ! status output from netcdf routines ! LCOV_EXCL_LINE
2045 : ndim, nvar ! sizes of netcdf file
2046 :
2047 : real (kind=dbl_kind), dimension(xdim,ydim,zdim) :: &
2048 0 : workg ! output array (real, 8-byte)
2049 :
2050 : !--------------------------------------------------------------
2051 :
2052 0 : if (my_task == master_task) then
2053 :
2054 0 : if (size(work,dim=1) < xdim .or. &
2055 : size(work,dim=2) < ydim .or. & ! LCOV_EXCL_LINE
2056 0 : size(work,dim=3) < zdim ) then
2057 0 : write(nu_diag,*) subname,' work, dim=1 ',size(work,dim=1),xdim
2058 0 : write(nu_diag,*) subname,' work, dim=2 ',size(work,dim=2),ydim
2059 0 : write(nu_diag,*) subname,' work, dim=3 ',size(work,dim=3),zdim
2060 : call abort_ice (subname//' ERROR: work array wrong size '//trim(varname), &
2061 0 : file=__FILE__, line=__LINE__ )
2062 : endif
2063 : !-------------------------------------------------------------
2064 : ! Find out ID of required variable
2065 : !-------------------------------------------------------------
2066 :
2067 0 : status = nf90_inq_varid(fid, trim(varname), varid)
2068 :
2069 0 : if (status /= nf90_noerr) then
2070 : call abort_ice (subname//' ERROR: Cannot find variable '//trim(varname), &
2071 0 : file=__FILE__, line=__LINE__ )
2072 : endif
2073 :
2074 : !--------------------------------------------------------------
2075 : ! Read array
2076 : !--------------------------------------------------------------
2077 0 : status = nf90_get_var( fid, varid, workg, &
2078 : start=(/1,1,1/), & ! LCOV_EXCL_LINE
2079 0 : count=(/xdim,ydim,zdim/) )
2080 0 : work(1:xdim,1:ydim,1:zdim) = workg(1:xdim, 1:ydim, 1:zdim)
2081 :
2082 : !-------------------------------------------------------------------
2083 : ! optional diagnostics
2084 : !-------------------------------------------------------------------
2085 :
2086 0 : if (diag) then
2087 0 : write(nu_diag,*) subname, &
2088 : ' fid= ',fid, ', xdim = ',xdim, & ! LCOV_EXCL_LINE
2089 0 : ' ydim= ', ydim,' zdim = ',zdim, ' varname = ',trim(varname)
2090 0 : status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar)
2091 0 : write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar
2092 : endif
2093 : endif
2094 : #else
2095 : call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', &
2096 : file=__FILE__, line=__LINE__)
2097 : work = c0 ! to satisfy intent(out) attribute
2098 : #endif
2099 :
2100 0 : end subroutine ice_read_nc_3D
2101 :
2102 : !=======================================================================
2103 :
2104 : ! Adapted by Nicole Jeffery, LANL
2105 :
2106 0 : subroutine ice_read_nc_z(fid, nrec, varname, work, diag, &
2107 : field_loc, field_type)
2108 :
2109 : use ice_domain_size, only: nilyr
2110 :
2111 : integer (kind=int_kind), intent(in) :: &
2112 : fid , & ! file id ! LCOV_EXCL_LINE
2113 : nrec ! record number
2114 :
2115 : logical (kind=log_kind), intent(in) :: &
2116 : diag ! if true, write diagnostic output
2117 :
2118 : character (char_len), intent(in) :: &
2119 : varname ! field name in netcdf file
2120 :
2121 : integer (kind=int_kind), optional, intent(in) :: &
2122 : field_loc, & ! location of field on staggered grid ! LCOV_EXCL_LINE
2123 : field_type ! type of field (scalar, vector, angle)
2124 :
2125 : real (kind=dbl_kind), dimension(nilyr), intent(out) :: &
2126 : work ! output array (real, 8-byte)
2127 :
2128 : ! local variables
2129 :
2130 : #ifdef USE_NETCDF
2131 : real (kind=dbl_kind), dimension(:), allocatable :: &
2132 0 : work_z
2133 :
2134 : ! netCDF file diagnostics:
2135 : integer (kind=int_kind) :: &
2136 : varid, & ! netcdf id for field ! LCOV_EXCL_LINE
2137 : status, & ! status output from netcdf routines ! LCOV_EXCL_LINE
2138 : ndim, nvar, & ! sizes of netcdf file ! LCOV_EXCL_LINE
2139 : id, & ! dimension index ! LCOV_EXCL_LINE
2140 : ndims, & ! number of dimensions ! LCOV_EXCL_LINE
2141 : dimlen ! dimension size
2142 :
2143 : integer (kind=int_kind), dimension(10) :: &
2144 : dimids ! generic size dimids
2145 :
2146 : character (char_len) :: &
2147 : dimname ! dimension name
2148 :
2149 : integer (kind=int_kind) :: lnrec ! local value of nrec
2150 :
2151 : #endif
2152 :
2153 : character(len=*), parameter :: subname = '(ice_read_nc_z)'
2154 :
2155 : #ifdef USE_NETCDF
2156 :
2157 0 : lnrec = nrec
2158 :
2159 0 : allocate(work_z(nilyr))
2160 :
2161 0 : if (my_task == master_task) then
2162 :
2163 : !-------------------------------------------------------------
2164 : ! Find out ID of required variable
2165 : !-------------------------------------------------------------
2166 :
2167 0 : status = nf90_inq_varid(fid, trim(varname), varid)
2168 0 : if (status /= nf90_noerr) then
2169 : call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), &
2170 0 : file=__FILE__, line=__LINE__)
2171 : endif
2172 :
2173 : !-------------------------------------------------------------
2174 : ! Check nrec axis size
2175 : !-------------------------------------------------------------
2176 :
2177 0 : status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids)
2178 0 : if (status /= nf90_noerr) then
2179 : call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), &
2180 0 : file=__FILE__, line=__LINE__)
2181 : endif
2182 0 : if (ndims > 1) then
2183 0 : status = nf90_inquire_dimension(fid, dimids(2), len=dimlen)
2184 0 : if (status /= nf90_noerr) then
2185 : call abort_ice(subname//' ERROR: inquire dimension size 2 '//trim(varname), &
2186 0 : file=__FILE__, line=__LINE__)
2187 : endif
2188 0 : if (lnrec > dimlen) then
2189 0 : write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen
2190 : call abort_ice(subname//' ERROR: not enough records '//trim(varname), &
2191 0 : file=__FILE__, line=__LINE__)
2192 : endif
2193 : endif
2194 :
2195 : !--------------------------------------------------------------
2196 : ! Read global array
2197 : !--------------------------------------------------------------
2198 :
2199 : status = nf90_get_var( fid, varid, work_z, &
2200 : start=(/1,lnrec/), & ! LCOV_EXCL_LINE
2201 0 : count=(/nilyr,1/))
2202 0 : if (status /= nf90_noerr) then
2203 : call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), &
2204 0 : file=__FILE__, line=__LINE__)
2205 : endif
2206 : endif ! my_task = master_task
2207 :
2208 : !-------------------------------------------------------------------
2209 : ! optional diagnostics
2210 : !-------------------------------------------------------------------
2211 :
2212 0 : if (my_task==master_task .and. diag) then
2213 : write(nu_diag,'(2a,i8,a,i8,2a)') &
2214 : subname,' fid= ',fid, ', lnrec = ',lnrec, & ! LCOV_EXCL_LINE
2215 0 : ', varname = ',trim(varname)
2216 0 : status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar)
2217 0 : write(nu_diag,*) subname,' ndim= ',ndim,', nvar= ',nvar
2218 0 : do id=1,ndim
2219 0 : status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen)
2220 0 : write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen
2221 : enddo
2222 : endif
2223 :
2224 0 : work(:) = work_z(:)
2225 0 : deallocate(work_z)
2226 :
2227 : #else
2228 : call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', &
2229 : file=__FILE__, line=__LINE__)
2230 : work = c0 ! to satisfy intent(out) attribute
2231 : #endif
2232 0 : end subroutine ice_read_nc_z
2233 :
2234 : !=======================================================================
2235 :
2236 : ! Write a netCDF file.
2237 : !
2238 : ! Adapted by David Bailey, NCAR
2239 :
2240 1274 : subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, &
2241 : restart_ext, varname)
2242 :
2243 : use ice_gather_scatter, only: gather_global, gather_global_ext
2244 :
2245 : integer (kind=int_kind), intent(in) :: &
2246 : fid , & ! file id ! LCOV_EXCL_LINE
2247 : varid , & ! variable id ! LCOV_EXCL_LINE
2248 : nrec ! record number
2249 :
2250 : logical (kind=log_kind), intent(in) :: &
2251 : diag ! if true, write diagnostic output
2252 :
2253 : logical (kind=log_kind), optional, intent(in) :: &
2254 : restart_ext ! if true, write extended grid
2255 :
2256 : real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(in) :: &
2257 : work ! output array (real, 8-byte)
2258 :
2259 : character (len=*), optional, intent(in) :: &
2260 : varname ! variable name
2261 :
2262 : ! local variables
2263 :
2264 : character(len=*), parameter :: subname = '(ice_write_nc_xy)'
2265 :
2266 : #ifdef USE_NETCDF
2267 : ! netCDF file diagnostics:
2268 : integer (kind=int_kind) :: &
2269 : status ! status output from netcdf routines
2270 : ! ndim, nvar, & ! sizes of netcdf file
2271 : ! id, & ! dimension index ! LCOV_EXCL_LINE
2272 : ! dimlen ! size of dimension
2273 :
2274 : real (kind=dbl_kind) :: &
2275 312 : amin, amax, asum ! min, max values and sum of input array
2276 :
2277 : character (char_len) :: &
2278 : lvarname ! variable name
2279 : ! dimname ! dimension name
2280 :
2281 : real (kind=dbl_kind), dimension(:,:), allocatable :: &
2282 1274 : work_g1
2283 :
2284 : integer (kind=int_kind) :: nx, ny
2285 :
2286 1274 : nx = nx_global
2287 1274 : ny = ny_global
2288 :
2289 1274 : if (present(restart_ext)) then
2290 0 : if (restart_ext) then
2291 0 : nx = nx_global + 2*nghost
2292 0 : ny = ny_global + 2*nghost
2293 : endif
2294 : endif
2295 :
2296 1274 : if (present(varname)) then
2297 1274 : lvarname = trim(varname)
2298 : else
2299 0 : lvarname = ' '
2300 : endif
2301 :
2302 1274 : if (my_task == master_task) then
2303 234 : allocate(work_g1(nx,ny))
2304 : else
2305 1040 : allocate(work_g1(1,1)) ! to save memory
2306 : endif
2307 :
2308 1274 : if (present(restart_ext)) then
2309 0 : if (restart_ext) then
2310 0 : call gather_global_ext(work_g1, work, master_task, distrb_info, spc_val=c0)
2311 : endif
2312 : else
2313 1274 : call gather_global(work_g1, work, master_task, distrb_info, spc_val=c0)
2314 : endif
2315 :
2316 1274 : if (my_task == master_task) then
2317 :
2318 : !--------------------------------------------------------------
2319 : ! Write global array
2320 : !--------------------------------------------------------------
2321 :
2322 : status = nf90_put_var( fid, varid, work_g1, &
2323 : start=(/1,1,nrec/), & ! LCOV_EXCL_LINE
2324 1638 : count=(/nx,ny,1/))
2325 :
2326 : endif ! my_task = master_task
2327 :
2328 : !-------------------------------------------------------------------
2329 : ! optional diagnostics
2330 : !-------------------------------------------------------------------
2331 :
2332 1274 : if (my_task==master_task .and. diag) then
2333 : ! write(nu_diag,*) &
2334 : ! subname,' fid= ',fid, ', nrec = ',nrec, & ! LCOV_EXCL_LINE
2335 : ! ', varid = ',varid
2336 : ! status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar)
2337 : ! write(nu_diag,*) subname,' ndim= ',ndim,', nvar= ',nvar
2338 : ! do id=1,ndim
2339 : ! status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen)
2340 : ! write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen
2341 : ! enddo
2342 3115866 : amin = minval(work_g1)
2343 3115866 : amax = maxval(work_g1, mask = work_g1 /= spval_dbl)
2344 3115866 : asum = sum (work_g1, mask = work_g1 /= spval_dbl)
2345 234 : write(nu_diag,*) subname,' min, max, sum =', amin, amax, asum, trim(lvarname)
2346 : endif
2347 :
2348 1274 : deallocate(work_g1)
2349 :
2350 : #else
2351 : call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', &
2352 : file=__FILE__, line=__LINE__)
2353 : #endif
2354 :
2355 2548 : end subroutine ice_write_nc_xy
2356 :
2357 : !=======================================================================
2358 :
2359 : ! Write a netCDF file.
2360 : !
2361 : ! Adapted by David Bailey, NCAR
2362 :
2363 1372 : subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, &
2364 : restart_ext, varname)
2365 :
2366 : use ice_gather_scatter, only: gather_global, gather_global_ext
2367 :
2368 : integer (kind=int_kind), intent(in) :: &
2369 : fid , & ! file id ! LCOV_EXCL_LINE
2370 : varid , & ! variable id ! LCOV_EXCL_LINE
2371 : nrec ! record number
2372 :
2373 : logical (kind=log_kind), intent(in) :: &
2374 : diag ! if true, write diagnostic output
2375 :
2376 : logical (kind=log_kind), optional, intent(in) :: &
2377 : restart_ext ! if true, read extended grid
2378 :
2379 : real (kind=dbl_kind), dimension(nx_block,ny_block,ncat,max_blocks), intent(in) :: &
2380 : work ! output array (real, 8-byte)
2381 :
2382 : character (len=*), optional, intent(in) :: &
2383 : varname ! variable name
2384 :
2385 : ! local variables
2386 :
2387 : character(len=*), parameter :: subname = '(ice_write_nc_xyz)'
2388 :
2389 : #ifdef USE_NETCDF
2390 : ! netCDF file diagnostics:
2391 : integer (kind=int_kind) :: &
2392 : n, & ! ncat index ! LCOV_EXCL_LINE
2393 : status ! status output from netcdf routines
2394 : ! ndim, nvar, & ! sizes of netcdf file
2395 : ! id, & ! dimension index ! LCOV_EXCL_LINE
2396 : ! dimlen ! size of dimension
2397 :
2398 : real (kind=dbl_kind) :: &
2399 336 : amin, amax, asum ! min, max values and sum of input array
2400 :
2401 : character (char_len) :: &
2402 : lvarname ! variable name
2403 : ! dimname ! dimension name
2404 :
2405 : real (kind=dbl_kind), dimension(:,:,:), allocatable :: &
2406 1372 : work_g1
2407 :
2408 : integer (kind=int_kind) :: nx, ny
2409 :
2410 1372 : nx = nx_global
2411 1372 : ny = ny_global
2412 :
2413 1372 : if (present(restart_ext)) then
2414 0 : if (restart_ext) then
2415 0 : nx = nx_global + 2*nghost
2416 0 : ny = ny_global + 2*nghost
2417 : endif
2418 : endif
2419 :
2420 1372 : if (my_task == master_task) then
2421 252 : allocate(work_g1(nx,ny,ncat))
2422 : else
2423 1120 : allocate(work_g1(1,1,ncat)) ! to save memory
2424 : endif
2425 :
2426 1372 : if (present(restart_ext)) then
2427 0 : if (restart_ext) then
2428 0 : do n=1,ncat
2429 0 : call gather_global_ext(work_g1(:,:,n), work(:,:,n,:), &
2430 0 : master_task, distrb_info, spc_val=c0)
2431 : enddo
2432 : endif
2433 : else
2434 8232 : do n=1,ncat
2435 0 : call gather_global(work_g1(:,:,n), work(:,:,n,:), &
2436 8232 : master_task, distrb_info, spc_val=c0)
2437 : enddo
2438 : endif
2439 :
2440 1372 : if (present(varname)) then
2441 1372 : lvarname = trim(varname)
2442 : else
2443 0 : lvarname = ' '
2444 : endif
2445 :
2446 1372 : if (my_task == master_task) then
2447 :
2448 : !--------------------------------------------------------------
2449 : ! Read global array
2450 : !--------------------------------------------------------------
2451 :
2452 : status = nf90_put_var( fid, varid, work_g1, &
2453 : start=(/1,1,1,nrec/), & ! LCOV_EXCL_LINE
2454 2268 : count=(/nx,ny,ncat,1/))
2455 :
2456 : endif ! my_task = master_task
2457 :
2458 : !-------------------------------------------------------------------
2459 : ! optional diagnostics
2460 : !-------------------------------------------------------------------
2461 :
2462 1372 : if (my_task==master_task .and. diag) then
2463 : ! write(nu_diag,*) &
2464 : ! subname,' fid= ',fid, ', nrec = ',nrec, & ! LCOV_EXCL_LINE
2465 : ! ', varid = ',varid
2466 : ! status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar)
2467 : ! write(nu_diag,*) subname,' ndim= ',ndim,', nvar= ',nvar
2468 : ! do id=1,ndim
2469 : ! status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen)
2470 : ! write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen
2471 : ! enddo
2472 252 : amin = 10000._dbl_kind
2473 252 : amax = -10000._dbl_kind
2474 1512 : do n=1,ncat
2475 16777740 : amin = minval(work_g1(:,:,n))
2476 16777740 : amax = maxval(work_g1(:,:,n), mask = work_g1(:,:,n) /= spval_dbl)
2477 16777740 : asum = sum (work_g1(:,:,n), mask = work_g1(:,:,n) /= spval_dbl)
2478 1512 : write(nu_diag,*) subname,' min, max, sum =', amin, amax, asum, trim(lvarname)
2479 : enddo
2480 : endif
2481 :
2482 1372 : deallocate(work_g1)
2483 :
2484 : #else
2485 : call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', &
2486 : file=__FILE__, line=__LINE__)
2487 : #endif
2488 :
2489 2744 : end subroutine ice_write_nc_xyz
2490 :
2491 : !=======================================================================
2492 :
2493 : ! Read a netcdf file.
2494 : ! Just like ice_read_nc except that it returns a global array.
2495 : ! work_g is a real array
2496 : !
2497 : ! Adapted by William Lipscomb, LANL, from ice_read
2498 : ! Adapted by Ann Keen, Met Office, to read from a netcdf file
2499 :
2500 0 : subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag)
2501 :
2502 : integer (kind=int_kind), intent(in) :: &
2503 : fid , & ! file id ! LCOV_EXCL_LINE
2504 : nrec ! record number
2505 :
2506 : character (char_len), intent(in) :: &
2507 : varname ! field name in netcdf file
2508 :
2509 : real (kind=dbl_kind), dimension(nx_global,ny_global), intent(out) :: &
2510 : work_g ! output array (real, 8-byte)
2511 :
2512 : logical (kind=log_kind) :: &
2513 : diag ! if true, write diagnostic output
2514 :
2515 : ! local variables
2516 :
2517 : character(len=*), parameter :: subname = '(ice_read_global_nc)'
2518 :
2519 : #ifdef USE_NETCDF
2520 : ! netCDF file diagnostics:
2521 : integer (kind=int_kind) :: &
2522 : varid, & ! netcdf id for field ! LCOV_EXCL_LINE
2523 : status ! status output from netcdf routines
2524 : ! ndim, nvar, & ! sizes of netcdf file
2525 : ! id, & ! dimension index ! LCOV_EXCL_LINE
2526 : ! dimlen ! size of dimension
2527 :
2528 : real (kind=dbl_kind) :: &
2529 0 : amin, amax, asum ! min, max values and sum of input array
2530 :
2531 : ! character (char_len) :: &
2532 : ! dimname ! dimension name
2533 : !
2534 : real (kind=dbl_kind), dimension(:,:), allocatable :: &
2535 0 : work_g3
2536 :
2537 0 : if (orca_halogrid) then
2538 0 : if (my_task == master_task) then
2539 0 : allocate(work_g3(nx_global+2,ny_global+1))
2540 : else
2541 0 : allocate(work_g3(1,1)) ! to save memory
2542 : endif
2543 0 : work_g3(:,:) = c0
2544 : endif
2545 :
2546 0 : work_g(:,:) = c0
2547 :
2548 0 : if (my_task == master_task) then
2549 :
2550 : !-------------------------------------------------------------
2551 : ! Find out ID of required variable
2552 : !-------------------------------------------------------------
2553 :
2554 0 : status = nf90_inq_varid(fid, trim(varname), varid)
2555 0 : if (status /= nf90_noerr) then
2556 : call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), &
2557 0 : file=__FILE__, line=__LINE__)
2558 : endif
2559 :
2560 : !--------------------------------------------------------------
2561 : ! Read global array
2562 : !--------------------------------------------------------------
2563 :
2564 0 : if (orca_halogrid) then
2565 : status = nf90_get_var( fid, varid, work_g3, &
2566 : start=(/1,1,nrec/), & ! LCOV_EXCL_LINE
2567 0 : count=(/nx_global+2,ny_global+1,1/))
2568 0 : if (status /= nf90_noerr) then
2569 : call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), &
2570 0 : file=__FILE__, line=__LINE__)
2571 : endif
2572 0 : work_g=work_g3(2:nx_global+1,1:ny_global)
2573 : else
2574 0 : status = nf90_get_var( fid, varid, work_g, &
2575 : start=(/1,1,nrec/), & ! LCOV_EXCL_LINE
2576 0 : count=(/nx_global,ny_global,1/))
2577 0 : if (status /= nf90_noerr) then
2578 : call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), &
2579 0 : file=__FILE__, line=__LINE__)
2580 : endif
2581 : endif
2582 : endif ! my_task = master_task
2583 :
2584 : !-------------------------------------------------------------------
2585 : ! optional diagnostics
2586 : !-------------------------------------------------------------------
2587 :
2588 0 : if (my_task == master_task .and. diag) then
2589 : ! write(nu_diag,*) &
2590 : ! subname,' fid= ',fid, ', nrec = ',nrec, & ! LCOV_EXCL_LINE
2591 : ! ', varname = ',trim(varname)
2592 : ! status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar)
2593 : ! write(nu_diag,*) subname,' ndim= ',ndim,', nvar= ',nvar
2594 : ! do id=1,ndim
2595 : ! status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen)
2596 : ! write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen
2597 : ! enddo
2598 0 : amin = minval(work_g)
2599 0 : amax = maxval(work_g, mask = work_g /= spval_dbl)
2600 0 : asum = sum (work_g, mask = work_g /= spval_dbl)
2601 0 : write(nu_diag,*) subname,' min, max, sum = ', amin, amax, asum, trim(varname)
2602 : endif
2603 :
2604 0 : if (orca_halogrid) deallocate(work_g3)
2605 :
2606 : #else
2607 : call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', &
2608 : file=__FILE__, line=__LINE__)
2609 : work_g = c0 ! to satisfy intent(out) attribute
2610 : #endif
2611 :
2612 0 : end subroutine ice_read_global_nc
2613 :
2614 : !=======================================================================
2615 :
2616 : ! Closes a netCDF file
2617 : ! author: Alison McLaren, Met Office
2618 :
2619 2904 : subroutine ice_close_nc(fid)
2620 :
2621 : integer (kind=int_kind), intent(in) :: &
2622 : fid ! unit number
2623 :
2624 : ! local variables
2625 :
2626 : character(len=*), parameter :: subname = '(ice_close_nc)'
2627 :
2628 : #ifdef USE_NETCDF
2629 : integer (kind=int_kind) :: &
2630 : status ! status variable from netCDF routine
2631 :
2632 2904 : if (my_task == master_task) then
2633 624 : status = nf90_close(fid)
2634 : endif
2635 : #else
2636 : call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', &
2637 : file=__FILE__, line=__LINE__)
2638 : #endif
2639 :
2640 2904 : end subroutine ice_close_nc
2641 :
2642 : !=======================================================================
2643 :
2644 : ! Read a netCDF file and scatter to processors.
2645 : ! If the optional variables field_loc and field_type are present,
2646 : ! the ghost cells are filled using values from the global array.
2647 : ! This prevents them from being filled with zeroes in land cells
2648 : ! (subroutine ice_HaloUpdate need not be called).
2649 : !
2650 : ! Adapted by Elizabeth Hunke for reading 3D ocean currents
2651 :
2652 0 : subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, &
2653 : field_loc, field_type, restart_ext)
2654 :
2655 : use ice_gather_scatter, only: scatter_global, scatter_global_ext
2656 :
2657 : integer (kind=int_kind), intent(in) :: &
2658 : fid , & ! file id ! LCOV_EXCL_LINE
2659 : nrec , & ! record number ! LCOV_EXCL_LINE
2660 : nzlev ! z level
2661 :
2662 : logical (kind=log_kind), intent(in) :: &
2663 : diag ! if true, write diagnostic output
2664 :
2665 : character (len=*), intent(in) :: &
2666 : varname ! field name in netcdf file
2667 :
2668 : real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(out) :: &
2669 : work ! output array (real, 8-byte)
2670 :
2671 : logical (kind=log_kind), optional, intent(in) :: &
2672 : restart_ext ! if true, read extended grid
2673 :
2674 : integer (kind=int_kind), optional, intent(in) :: &
2675 : field_loc, & ! location of field on staggered grid ! LCOV_EXCL_LINE
2676 : field_type ! type of field (scalar, vector, angle)
2677 :
2678 : ! local variables
2679 :
2680 : character(len=*), parameter :: subname = '(ice_read_nc_uv)'
2681 :
2682 : #ifdef USE_NETCDF
2683 : ! netCDF file diagnostics:
2684 : integer (kind=int_kind) :: &
2685 : varid , & ! variable id ! LCOV_EXCL_LINE
2686 : status ! status output from netcdf routines
2687 : ! ndim, nvar, & ! sizes of netcdf file
2688 : ! id, & ! dimension index ! LCOV_EXCL_LINE
2689 : ! dimlen ! size of dimension
2690 :
2691 : real (kind=dbl_kind) :: &
2692 0 : amin, amax, asum ! min, max values and sum of input array
2693 :
2694 : ! character (char_len) :: &
2695 : ! dimname ! dimension name
2696 :
2697 : real (kind=dbl_kind), dimension(:,:), allocatable :: &
2698 0 : work_g1
2699 :
2700 : integer (kind=int_kind) :: nx, ny
2701 :
2702 0 : nx = nx_global
2703 0 : ny = ny_global
2704 :
2705 0 : if (present(restart_ext)) then
2706 0 : if (restart_ext) then
2707 0 : nx = nx_global + 2*nghost
2708 0 : ny = ny_global + 2*nghost
2709 : endif
2710 : endif
2711 :
2712 0 : if (my_task == master_task) then
2713 0 : allocate(work_g1(nx,ny))
2714 : else
2715 0 : allocate(work_g1(1,1)) ! to save memory
2716 : endif
2717 :
2718 0 : if (my_task == master_task) then
2719 :
2720 : !-------------------------------------------------------------
2721 : ! Find out ID of required variable
2722 : !-------------------------------------------------------------
2723 :
2724 0 : status = nf90_inq_varid(fid, trim(varname), varid)
2725 0 : if (status /= nf90_noerr) then
2726 : call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), &
2727 0 : file=__FILE__, line=__LINE__)
2728 : endif
2729 :
2730 : !--------------------------------------------------------------
2731 : ! Read global array
2732 : !--------------------------------------------------------------
2733 :
2734 : status = nf90_get_var( fid, varid, work_g1, &
2735 : start=(/1,1,nzlev,nrec/), & ! LCOV_EXCL_LINE
2736 0 : count=(/nx,ny,1,1/))
2737 0 : if (status /= nf90_noerr) then
2738 : call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), &
2739 0 : file=__FILE__, line=__LINE__)
2740 : endif
2741 :
2742 : endif ! my_task = master_task
2743 :
2744 : !-------------------------------------------------------------------
2745 : ! optional diagnostics
2746 : !-------------------------------------------------------------------
2747 :
2748 0 : if (my_task==master_task .and. diag) then
2749 0 : amin = minval(work_g1)
2750 0 : amax = maxval(work_g1, mask = work_g1 /= spval_dbl)
2751 0 : asum = sum (work_g1, mask = work_g1 /= spval_dbl)
2752 0 : write(nu_diag,*) subname,' min, max, sum =', amin, amax, asum, trim(varname)
2753 : endif
2754 :
2755 : !-------------------------------------------------------------------
2756 : ! Scatter data to individual processors.
2757 : ! NOTE: Ghost cells are not updated unless field_loc is present.
2758 : !-------------------------------------------------------------------
2759 :
2760 0 : if (present(restart_ext)) then
2761 0 : if (restart_ext) then
2762 0 : call scatter_global_ext(work, work_g1, master_task, distrb_info)
2763 : endif
2764 : else
2765 0 : if (present(field_loc)) then
2766 0 : call scatter_global(work, work_g1, master_task, distrb_info, &
2767 0 : field_loc, field_type)
2768 : else
2769 0 : call scatter_global(work, work_g1, master_task, distrb_info, &
2770 0 : field_loc_noupdate, field_type_noupdate)
2771 : endif
2772 : endif
2773 :
2774 0 : deallocate(work_g1)
2775 :
2776 : #else
2777 : call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', &
2778 : file=__FILE__, line=__LINE__)
2779 : work = c0 ! to satisfy intent(out) attribute
2780 : #endif
2781 :
2782 0 : end subroutine ice_read_nc_uv
2783 :
2784 : !=======================================================================
2785 : ! Read a vector in a netcdf file.
2786 : ! Just like ice_read_global_nc except that it returns a vector.
2787 : ! work_g is a real vector
2788 : !
2789 : ! Adapted by William Lipscomb, LANL, from ice_read
2790 : ! Adapted by Ann Keen, Met Office, to read from a netcdf file
2791 :
2792 0 : subroutine ice_read_vec_nc (fid, nrec, varname, work_g, diag)
2793 :
2794 : integer (kind=int_kind), intent(in) :: &
2795 : fid , & ! file id ! LCOV_EXCL_LINE
2796 : nrec ! record number
2797 :
2798 : character (char_len), intent(in) :: &
2799 : varname ! field name in netcdf file
2800 :
2801 : real (kind=dbl_kind), dimension(nrec), &
2802 : intent(out) :: & ! LCOV_EXCL_LINE
2803 : work_g ! output array (real, 8-byte)
2804 :
2805 : logical (kind=log_kind) :: &
2806 : diag ! if true, write diagnostic output
2807 :
2808 : ! local variables
2809 :
2810 : character(len=*), parameter :: subname = '(ice_read_vec_nc)'
2811 :
2812 : #ifdef USE_NETCDF
2813 : ! netCDF file diagnostics:
2814 : integer (kind=int_kind) :: &
2815 : varid, & ! netcdf id for field ! LCOV_EXCL_LINE
2816 : status ! status output from netcdf routines
2817 :
2818 : real (kind=dbl_kind) :: &
2819 0 : amin, amax ! min, max values of input vector
2820 :
2821 0 : work_g(:) = c0
2822 :
2823 0 : if (my_task == master_task) then
2824 :
2825 : !-------------------------------------------------------------
2826 : ! Find out ID of required variable
2827 : !-------------------------------------------------------------
2828 :
2829 0 : status = nf90_inq_varid(fid, trim(varname), varid)
2830 0 : if (status /= nf90_noerr) then
2831 : call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), &
2832 0 : file=__FILE__, line=__LINE__)
2833 : endif
2834 :
2835 : !--------------------------------------------------------------
2836 : ! Read global array
2837 : !--------------------------------------------------------------
2838 :
2839 0 : status = nf90_get_var( fid, varid, work_g, &
2840 : start=(/1/), & ! LCOV_EXCL_LINE
2841 0 : count=(/nrec/))
2842 0 : if (status /= nf90_noerr) then
2843 : call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), &
2844 0 : file=__FILE__, line=__LINE__)
2845 : endif
2846 :
2847 : endif ! my_task = master_task
2848 :
2849 : !-------------------------------------------------------------------
2850 : ! optional diagnostics
2851 : !-------------------------------------------------------------------
2852 :
2853 0 : if (my_task == master_task .and. diag) then
2854 0 : amin = minval(work_g)
2855 0 : amax = maxval(work_g)
2856 0 : write(nu_diag,*) subname,' min, max, nrec = ', amin, amax, nrec
2857 : endif
2858 :
2859 : #else
2860 : call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', &
2861 : file=__FILE__, line=__LINE__)
2862 : work_g = c0 ! to satisfy intent(out) attribute
2863 : #endif
2864 :
2865 0 : end subroutine ice_read_vec_nc
2866 :
2867 : !=======================================================================
2868 : ! Get number of variables of a given variable
2869 0 : subroutine ice_get_ncvarsize(fid,varname,recsize)
2870 :
2871 : integer (kind=int_kind), intent(in) :: &
2872 : fid ! file id
2873 : character (char_len), intent(in) :: &
2874 : varname ! field name in netcdf file
2875 : integer (kind=int_kind), intent(out) :: &
2876 : recsize ! Number of records in file
2877 :
2878 : ! local variables
2879 :
2880 : #ifdef USE_NETCDF
2881 : integer (kind=int_kind) :: &
2882 : ndims, i, status
2883 : character (char_len) :: &
2884 : cvar
2885 : #endif
2886 : character(len=*), parameter :: subname = '(ice_get_ncvarsize)'
2887 :
2888 : #ifdef USE_NETCDF
2889 0 : if (my_task == master_task) then
2890 0 : status=nf90_inquire(fid, nDimensions = nDims)
2891 0 : if (status /= nf90_noerr) then
2892 : call abort_ice(subname//' ERROR: inquire nDimensions', &
2893 0 : file=__FILE__, line=__LINE__ )
2894 : endif
2895 0 : do i=1,nDims
2896 0 : status = nf90_inquire_dimension(fid,i,name=cvar,len=recsize)
2897 0 : if (status /= nf90_noerr) then
2898 : call abort_ice(subname//' ERROR: inquire len for variable '//trim(cvar), &
2899 0 : file=__FILE__, line=__LINE__)
2900 : endif
2901 0 : if (trim(cvar) == trim(varname)) exit
2902 : enddo
2903 0 : if (trim(cvar) .ne. trim(varname)) then
2904 : call abort_ice(subname//' ERROR: Did not find variable '//trim(varname), &
2905 0 : file=__FILE__, line=__LINE__)
2906 : endif
2907 : endif
2908 : #else
2909 : call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', &
2910 : file=__FILE__, line=__LINE__)
2911 : recsize = 0 ! to satisfy intent(out) attribute
2912 : #endif
2913 :
2914 0 : end subroutine ice_get_ncvarsize
2915 :
2916 : !=======================================================================
2917 :
2918 : end module ice_read_write
2919 :
2920 : !=======================================================================
|
