!=======================================================================
!BOP
!
! !MODULE: ice_read_write
!
! !DESCRIPTION:
!
! Routines for opening, reading and writing external files
!
! !REVISION HISTORY:
! SVN:$Id$
!
! author: Tony Craig, NCAR
!
! 2004: Block structure added by William Lipscomb, LANL
! 2006: Converted to free source form (F90) by Elizabeth Hunke
! 2007: netcdf versions added by Alison McLaren & Ann Keen, Met Office
!
! !INTERFACE:
!
module ice_read_write 16,9
!
! !USES:
!
use ice_kinds_mod
use ice_constants
use ice_communicate, only: my_task, master_task
use ice_broadcast
use ice_domain_size
use ice_blocks
use ice_fileunits
#ifdef ncdf
use netcdf
#endif
!
!EOP
implicit none
public :: ice_read_global_nc
interface ice_read_global_nc 8
module procedure ice_read_global_nc_dbl
ice_read_global_nc_r4
end interface
!=======================================================================
contains
!=======================================================================
!
!BOP
!
! !IROUTINE: ice_open - opens an unformatted file for reading
!
! !INTERFACE:
!
subroutine ice_open(nu, filename, nbits) 28
!
! !DESCRIPTION:
!
! Opens an unformatted file for reading \\
! nbits indicates whether the file is sequential or direct access
!
! !REVISION HISTORY:
!
! author: Tony Craig, NCAR
!
! !USES:
!
! !INPUT/OUTPUT PARAMETERS:
!
integer (kind=int_kind), intent(in) :: &
nu , & ! unit number
nbits ! no. of bits per variable (0 for sequential access)
character (*) :: filename
!
!EOP
!
if (my_task == master_task) then
if (nbits == 0) then ! sequential access
open(nu,file=filename,form='unformatted')
else ! direct access
open(nu,file=filename,recl=nx_global*ny_global*nbits/8, &
form='unformatted',access='direct')
endif ! nbits = 0
endif ! my_task = master_task
end subroutine ice_open
!=======================================================================
!BOP
!
! !IROUTINE: ice_read - read and scatter an unformatted file
!
! !INTERFACE:
!
subroutine ice_read(nu, nrec, work, atype, diag, & 44,6
field_loc, field_type, &
ignore_eof, hit_eof)
!
! !DESCRIPTION:
!
! Read an unformatted file and scatter to processors\\
! work is a real array, atype indicates the format of the data\\
! If the optional variables field_loc and field_type are present \\
! the ghost cells are filled using values from the global array.\\
! This prevents them from being filled with zeroes in land cells \\
! (subroutine ice_HaloUpdate need not be called).
!
! !REVISION HISTORY:
!
! author: Tony Craig, NCAR
!
! !USES:
!
use ice_domain
use ice_gather_scatter
use ice_work, only: work_g1, work_gr, work_gi4, work_gi8
!
! !INPUT/OUTPUT PARAMETERS:
!
integer (kind=int_kind), intent(in) :: &
nu , & ! unit number
nrec ! record number (0 for sequential access)
real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), &
intent(out) :: &
work ! output array (real, 8-byte)
character (len=4), intent(in) :: &
atype ! format for input array
! (real/integer, 4-byte/8-byte)
logical (kind=log_kind), intent(in) :: &
diag ! if true, write diagnostic output
integer (kind=int_kind), optional, intent(in) :: &
field_loc, & ! location of field on staggered grid
field_type ! type of field (scalar, vector, angle)
logical (kind=log_kind), optional, intent(in) :: ignore_eof
logical (kind=log_kind), optional, intent(out) :: hit_eof
!
!EOP
!
integer (kind=int_kind) :: i, j, ios
real (kind=dbl_kind) :: &
amin, amax ! min and max values of input array
logical (kind=log_kind) :: ignore_eof_use
if (my_task == master_task) then
allocate(work_g1(nx_global,ny_global))
else
allocate(work_g1(1,1)) ! to save memory
endif
if (my_task == master_task) then
!-------------------------------------------------------------------
! Read global array according to format atype
!-------------------------------------------------------------------
if (present(hit_eof)) hit_eof = .false.
if (atype == 'ida4') then
allocate(work_gi4(nx_global,ny_global))
read(nu,rec=nrec) work_gi4
work_g1 = real(work_gi4,kind=dbl_kind)
deallocate(work_gi4)
elseif (atype == 'ida8') then
allocate(work_gi8(nx_global,ny_global))
read(nu,rec=nrec) work_gi8
work_g1 = real(work_gi8,kind=dbl_kind)
deallocate(work_gi8)
elseif (atype == 'rda4') then
allocate(work_gr(nx_global,ny_global))
read(nu,rec=nrec) work_gr
work_g1 = work_gr
deallocate(work_gr)
elseif (atype == 'rda8') then
read(nu,rec=nrec) work_g1
elseif (atype == 'ruf8') then
if (present(ignore_eof)) then
ignore_eof_use = ignore_eof
else
ignore_eof_use = .false.
endif
if (ignore_eof_use) then
! Read line from file, checking for end-of-file
read(nu, iostat=ios) ((work_g1(i,j),i=1,nx_global), &
j=1,ny_global)
if (present(hit_eof)) hit_eof = ios < 0
else
read(nu) ((work_g1(i,j),i=1,nx_global),j=1,ny_global)
endif
else
write(nu_diag,*) ' ERROR: reading unknown atype ',atype
endif
endif ! my_task = master_task
if (present(hit_eof)) then
call broadcast_scalar(hit_eof,master_task)
if (hit_eof) then
deallocate(work_g1)
return
endif
endif
!-------------------------------------------------------------------
! optional diagnostics
!-------------------------------------------------------------------
if (my_task==master_task .and. diag) then
amin = minval(work_g1)
amax = maxval(work_g1, mask = work_g1 /= spval_dbl)
write(nu_diag,*) ' read_global ',nu, nrec, amin, amax
endif
!-------------------------------------------------------------------
! Scatter data to individual processors.
! NOTE: Ghost cells are not updated unless field_loc is present.
!-------------------------------------------------------------------
if (present(field_loc)) then
call scatter_global(work, work_g1, master_task, distrb_info, &
field_loc, field_type)
else
call scatter_global(work, work_g1, master_task, distrb_info, &
field_loc_noupdate, field_type_noupdate)
endif
deallocate(work_g1)
end subroutine ice_read
!=======================================================================
!BOP
!
! !IROUTINE: ice_read_global - read an unformatted file
!
! !INTERFACE:
!
subroutine ice_read_global (nu, nrec, work_g, atype, diag, & 26,2
ignore_eof, hit_eof)
!
! !DESCRIPTION:
!
! Read an unformatted file \\
! Just like ice_read except that it returns a global array \\
! work_g is a real array, atype indicates the format of the data
!
! !REVISION HISTORY:
! Adapted by William Lipscomb, LANL, from ice_read
!
! !USES:
!
use ice_work, only: work_gr, work_gi4, work_gi8
!
! !INPUT/OUTPUT PARAMETERS:
!
integer (kind=int_kind), intent(in) :: &
nu , & ! unit number
nrec ! record number (0 for sequential access)
real (kind=dbl_kind), dimension(:,:), &
intent(out) :: &
work_g ! output array (real, 8-byte)
character (len=4) :: &
atype ! format for input array
! (real/integer, 4-byte/8-byte)
logical (kind=log_kind) :: &
diag ! if true, write diagnostic output
logical (kind=log_kind), optional, intent(in) :: ignore_eof
logical (kind=log_kind), optional, intent(out) :: hit_eof
!
!EOP
!
integer (kind=int_kind) :: i, j, ios
real (kind=dbl_kind) :: &
amin, amax ! min and max values of input array
logical (kind=log_kind) :: ignore_eof_use
work_g(:,:) = c0
if (my_task == master_task) then
!-------------------------------------------------------------------
! Read global array according to format atype
!-------------------------------------------------------------------
if (present(hit_eof)) hit_eof = .false.
if (atype == 'ida4') then
allocate(work_gi4(nx_global,ny_global))
read(nu,rec=nrec) work_gi4
work_g = real(work_gi4,kind=dbl_kind)
deallocate(work_gi4)
elseif (atype == 'ida8') then
allocate(work_gi8(nx_global,ny_global))
read(nu,rec=nrec) work_gi8
work_g = real(work_gi8,kind=dbl_kind)
deallocate(work_gi8)
elseif (atype == 'rda4') then
allocate(work_gr(nx_global,ny_global))
read(nu,rec=nrec) work_gr
work_g = work_gr
deallocate(work_gr)
elseif (atype == 'rda8') then
read(nu,rec=nrec) work_g
elseif (atype == 'ruf8') then
if (present(ignore_eof)) then
ignore_eof_use = ignore_eof
else
ignore_eof_use = .false.
endif
if (ignore_eof_use) then
! Read line from file, checking for end-of-file
read(nu, iostat=ios) ((work_g(i,j),i=1,nx_global), &
j=1,ny_global)
if (present(hit_eof)) hit_eof = ios < 0
else
read(nu) ((work_g(i,j),i=1,nx_global),j=1,ny_global)
endif
else
write(nu_diag,*) ' ERROR: reading unknown atype ',atype
endif
endif ! my_task = master_task
if (present(hit_eof)) then
call broadcast_scalar(hit_eof,master_task)
if (hit_eof) return
endif
!-------------------------------------------------------------------
! optional diagnostics
!-------------------------------------------------------------------
if (my_task == master_task .and. diag) then
amin = minval(work_g)
amax = maxval(work_g, mask = work_g /= spval_dbl)
write(nu_diag,*) ' read_global ',nu, nrec, amin, amax
endif
end subroutine ice_read_global
!=======================================================================
!BOP
!
! !IROUTINE: ice_write - writes an unformatted file
!
! !INTERFACE:
!
subroutine ice_write(nu, nrec, work, atype, diag) 43,4
!
! !DESCRIPTION:
!
! Writes an unformatted file \\
! work is a real array, atype indicates the format of the data
!
! !REVISION HISTORY:
!
! author: Tony Craig, NCAR
!
! !USES:
!
use ice_gather_scatter
use ice_domain
use ice_work, only: work_g1, work_gr, work_gi4, work_gi8
!
! !INPUT/OUTPUT PARAMETERS:
!
integer (kind=int_kind), intent(in) :: &
nu , & ! unit number
nrec ! record number (0 for sequential access)
real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), &
intent(in) :: &
work ! input array (real, 8-byte)
character (len=4) :: &
atype ! format for output array
! (real/integer, 4-byte/8-byte)
logical (kind=log_kind) :: &
diag ! if true, write diagnostic output
!
!EOP
!
integer (kind=int_kind) :: i, j
real (kind=dbl_kind) :: &
amin, amax ! min and max values of ouput array
!-------------------------------------------------------------------
! Gather data from individual processors
!-------------------------------------------------------------------
if (my_task == master_task) then
allocate(work_g1(nx_global,ny_global))
else
allocate(work_g1(1,1)) ! to save memory
endif
call gather_global(work_g1, work, master_task, distrb_info)
if (my_task == master_task) then
!-------------------------------------------------------------------
! Write global array according to format atype
!-------------------------------------------------------------------
if (atype == 'ida4') then
allocate(work_gi4(nx_global,ny_global))
work_gi4 = nint(work_g1)
write(nu,rec=nrec) work_gi4
deallocate(work_gi4)
elseif (atype == 'ida8') then
allocate(work_gi8(nx_global,ny_global))
work_gi8 = nint(work_g1)
write(nu,rec=nrec) work_gi8
deallocate(work_gi8)
elseif (atype == 'rda4') then
allocate(work_gr(nx_global,ny_global))
work_gr = work_g1
write(nu,rec=nrec) work_gr
deallocate(work_gr)
elseif (atype == 'rda8') then
write(nu,rec=nrec) work_g1
elseif (atype == 'ruf8') then
write(nu) ((work_g1(i,j),i=1,nx_global),j=1,ny_global)
else
write(nu_diag,*) ' ERROR: writing unknown atype ',atype
endif
!-------------------------------------------------------------------
! diagnostics
!-------------------------------------------------------------------
if (diag) then
amin = minval(work_g1)
amax = maxval(work_g1, mask = work_g1 /= spval_dbl)
write(nu_diag,*) ' write_global ', nu, nrec, amin, amax
endif
endif ! my_task = master_task
deallocate(work_g1)
end subroutine ice_write
!=======================================================================
!BOP
!
! !IROUTINE: ice_write_nc - writes a field to a netcdf file
!
! !INTERFACE:
!
subroutine ice_write_nc(fid, nrec, varname, work, atype, diag),7
!
! !DESCRIPTION:
!
! Writes a field to a netcdf file \\
! work is a real array, atype indicates the format of the data
!
! !REVISION HISTORY:
!
! author: David A Bailey, NCAR
!
! !USES:
!
use ice_gather_scatter
use ice_domain
use ice_work, only: work_g1, work_gr, work_gi4, work_gi8
use ice_exit
!
! !INPUT/OUTPUT PARAMETERS:
!
integer (kind=int_kind), intent(in) :: &
fid ,& ! netcdf file id
nrec ! record number
character (len=*), intent(in) :: varname
real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), &
intent(in) :: &
work ! input array (real, 8-byte)
character (len=4), intent(in) :: &
atype ! format for output array
! (real/integer, 4-byte/8-byte)
logical (kind=log_kind), intent(in) :: &
diag ! if true, write diagnostic output
!
!EOP
!
integer (kind=int_kind) :: i, j, varid, numDims
integer (kind=int_kind) :: &
status ! status variable from netCDF routine
real (kind=dbl_kind) :: &
amin, amax ! min and max values of ouput array
integer (kind=int_kind), allocatable :: &
start_arr(:), count_arr(:)
!-------------------------------------------------------------------
! Gather data from individual processors
!-------------------------------------------------------------------
if (my_task == master_task) then
allocate(work_g1(nx_global,ny_global))
else
allocate(work_g1(1,1)) ! to save memory
endif
call gather_global(work_g1, work, master_task, distrb_info)
if (my_task == master_task) then
status = nf90_inq_varid(fid, trim(varname), varid)
if (status /= nf90_noerr) then
call abort_ice ( &
'ice_write_nc: Cannot find variable '//trim(varname) )
endif
status = nf90_inquire_variable(fid, varid, ndims = numDims)
if (status /= nf90_noerr) then
call abort_ice ( &
'ice_write_nc: Cannot find dimensions for '//trim(varname) )
endif
allocate(start_arr(numDims))
allocate(count_arr(numDims))
if (numDims > 2) then
start_arr(1) = 1
start_arr(2) = 1
start_arr(3) = nrec
count_arr(1) = nx_global
count_arr(2) = ny_global
count_arr(3) = 1
else
start_arr(1) = 1
start_arr(2) = 1
count_arr(1) = nx_global
count_arr(2) = ny_global
endif
!-------------------------------------------------------------------
! Write global array according to format atype
!-------------------------------------------------------------------
if (atype == 'ida4') then
allocate(work_gi4(nx_global,ny_global))
work_gi4 = nint(work_g1)
status = nf90_put_var(fid,varid,work_gi4, &
start=start_arr, &
count=count_arr)
deallocate(work_gi4)
elseif (atype == 'ida8') then
allocate(work_gi8(nx_global,ny_global))
work_gi8 = nint(work_g1)
status = nf90_put_var(fid,varid,work_gi8, &
start=start_arr, &
count=count_arr)
deallocate(work_gi8)
elseif (atype == 'rda4') then
allocate(work_gr(nx_global,ny_global))
work_gr = work_g1
status = nf90_put_var(fid,varid,work_gr, &
start=start_arr, &
count=count_arr)
deallocate(work_gr)
elseif (atype == 'rda8') then
status = nf90_put_var(fid,varid,work_g1, &
start=start_arr, &
count=count_arr)
else
write(nu_diag,*) ' ERROR: writing unknown atype ',atype
endif
!-------------------------------------------------------------------
! diagnostics
!-------------------------------------------------------------------
if (diag) then
amin = minval(work_g1)
amax = maxval(work_g1, mask = work_g1 /= spval_dbl)
write(nu_diag,*) ' write_global ', fid, varid, nrec, amin, amax
endif
deallocate(start_arr)
deallocate(count_arr)
endif ! my_task = master_task
deallocate(work_g1)
end subroutine ice_write_nc
!=======================================================================
!
!BOP
!
! !IROUTINE: ice_open_nc - opens a netCDF file for reading
!
! !INTERFACE:
!
subroutine ice_open_nc(filename, fid) 12,2
!
! !DESCRIPTION:
!
! Opens a netCDF file for reading
!
! !REVISION HISTORY:
!
! Adapted by Alison McLaren, Met Office from ice_open
!
! !USES:
use ice_exit
!
! !INPUT/OUTPUT PARAMETERS:
!
character (char_len_long), intent(in) :: &
filename ! netCDF filename
integer (kind=int_kind), intent(out) :: &
fid ! unit number
!
!EOP
!
#ifdef ncdf
integer (kind=int_kind) :: &
status ! status variable from netCDF routine
if (my_task == master_task) then
status = nf90_open(filename, NF90_NOWRITE, fid)
if (status /= nf90_noerr) then
call abort_ice ( &
'ice_open_nc: Cannot open '//trim(filename) )
endif
endif ! my_task = master_task
#else
fid = -999 ! to satisfy intent(out) attribute
#endif
end subroutine ice_open_nc
!=======================================================================
!BOP
!
! !IROUTINE: ice_read_nc - read and scatter one field from a netCDF file
!
! !INTERFACE:
!
subroutine ice_read_nc(fid, nrec, varname, work, diag, & 12,8
field_loc, field_type)
!
! !DESCRIPTION:
!
! Read a netCDF file and scatter to processors\\
! If the optional variables field_loc and field_type are present \\
! the ghost cells are filled using values from the global array.\\
! This prevents them from being filled with zeroes in land cells \\
! (subroutine ice_HaloUpdate need not be called).
!
! !REVISION HISTORY:
!
! Adapted by Alison McLaren, Met Office from ice_read
!
! !USES:
!
use ice_domain
use ice_gather_scatter
#ifdef ORCA_GRID
use ice_work, only: work_g1, work_g2
#else
use ice_work, only: work_g1
#endif
use ice_exit
!
! !INPUT/OUTPUT PARAMETERS:
!
integer (kind=int_kind), intent(in) :: &
fid , & ! file id
nrec ! record number
logical (kind=log_kind), intent(in) :: &
diag ! if true, write diagnostic output
character (len=*), intent(in) :: &
varname ! field name in netcdf file
real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), &
intent(out) :: &
work ! output array (real, 8-byte)
integer (kind=int_kind), optional, intent(in) :: &
field_loc, & ! location of field on staggered grid
field_type ! type of field (scalar, vector, angle)
!
!EOP
!
#ifdef ncdf
! netCDF file diagnostics:
integer (kind=int_kind) :: &
varid, & ! netcdf id for field
status, & ! status output from netcdf routines
ndim, nvar, & ! sizes of netcdf file
id, & ! dimension index
dimlen ! size of dimension
real (kind=dbl_kind) :: &
amin, amax ! min and max values of input array
character (char_len) :: &
dimname ! dimension name
!
if (my_task == master_task) then
allocate(work_g1(nx_global,ny_global))
else
allocate(work_g1(1,1)) ! to save memory
endif
#ifdef ORCA_GRID
if (my_task == master_task) then
allocate(work_g2(nx_global+2,ny_global+1))
else
allocate(work_g2(1,1)) ! to save memory
endif
#endif
if (my_task == master_task) then
!-------------------------------------------------------------
! Find out ID of required variable
!-------------------------------------------------------------
status = nf90_inq_varid(fid, trim(varname), varid)
if (status /= nf90_noerr) then
call abort_ice ( &
'ice_read_nc: Cannot find variable '//trim(varname) )
endif
!--------------------------------------------------------------
! Read global array
!--------------------------------------------------------------
#ifndef ORCA_GRID
status = nf90_get_var( fid, varid, work_g1, &
start=(/1,1,nrec/), &
count=(/nx_global,ny_global,1/) )
#else
status = nf90_get_var( fid, varid, work_g2, &
start=(/1,1,nrec/), &
count=(/nx_global+2,ny_global+1,1/) )
work_g1=work_g2(2:nx_global+1,1:ny_global)
#endif
endif ! my_task = master_task
!-------------------------------------------------------------------
! optional diagnostics
!-------------------------------------------------------------------
if (my_task==master_task .and. diag) then
! write(nu_diag,*) &
! 'ice_read_nc, fid= ',fid, ', nrec = ',nrec, &
! ', varname = ',trim(varname)
status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar)
! write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar
do id=1,ndim
status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen)
! write(nu_diag,*) 'Dim name = ',trim(dimname),', size = ',dimlen
enddo
amin = minval(work_g1)
amax = maxval(work_g1, mask = work_g1 /= spval_dbl)
write(nu_diag,*) ' read_global ',fid, varid, nrec, amin, amax
endif
!-------------------------------------------------------------------
! Scatter data to individual processors.
! NOTE: Ghost cells are not updated unless field_loc is present.
!-------------------------------------------------------------------
if (present(field_loc)) then
call scatter_global(work, work_g1, master_task, distrb_info, &
field_loc, field_type)
else
call scatter_global(work, work_g1, master_task, distrb_info, &
field_loc_noupdate, field_type_noupdate)
endif
deallocate(work_g1)
#ifdef ORCA_GRID
deallocate(work_g2)
#endif
#else
work = c0 ! to satisfy intent(out) attribute
#endif
end subroutine ice_read_nc
!
!=======================================================================
!BOP
!
! !IROUTINE: ice_read_global_nc - read one field from a netcdf file
!
! !INTERFACE:
!
subroutine ice_read_global_nc_dbl (fid, nrec, varname, work_g, diag) 1,3
!
! !DESCRIPTION:
!
! Read a netcdf file \\
! Just like ice_read_nc except that it returns a global array \\
! work_g is a real array
!
! !REVISION HISTORY:
! Adapted by William Lipscomb, LANL, from ice_read
! Adapted by Ann Keen, Met Office, to read from a netcdf file
!
! !USES:
!
use ice_exit
#ifdef ORCA_GRID
use ice_work, only: work_g3
#endif
!
! !INPUT/OUTPUT PARAMETERS:
!
integer (kind=int_kind), intent(in) :: &
fid , & ! file id
nrec ! record number
character (len=*), intent(in) :: &
varname ! field name in netcdf file
real (kind=dbl_kind), dimension(:,:), &
intent(out) :: &
work_g ! output array (real, 8-byte)
logical (kind=log_kind) :: &
diag ! if true, write diagnostic output
!
!EOP
!
#ifdef ncdf
! netCDF file diagnostics:
integer (kind=int_kind) :: &
varid, & ! netcdf id for field
status, & ! status output from netcdf routines
ndim, nvar, & ! sizes of netcdf file
id, & ! dimension index
dimlen ! size of dimension
real (kind=dbl_kind) :: &
amin, amax ! min and max values of input array
character (char_len) :: &
dimname ! dimension name
!
#ifdef ORCA_GRID
if (my_task == master_task) then
allocate(work_g3(nx_global+2,ny_global+1))
else
allocate(work_g3(1,1)) ! to save memory
endif
work_g3(:,:) = c0
#endif
work_g(:,:) = c0
if (my_task == master_task) then
!-------------------------------------------------------------
! Find out ID of required variable
!-------------------------------------------------------------
status = nf90_inq_varid(fid, trim(varname), varid)
if (status /= nf90_noerr) then
call abort_ice ( &
'ice_read_global_nc: Cannot find variable '//trim(varname) )
endif
!--------------------------------------------------------------
! Read global array
!--------------------------------------------------------------
#ifndef ORCA_GRID
status = nf90_get_var( fid, varid, work_g, &
start=(/1,1,nrec/), &
count=(/nx_global,ny_global,1/) )
#else
status = nf90_get_var( fid, varid, work_g3, &
start=(/1,1,nrec/), &
count=(/nx_global+2,ny_global+1,1/) )
work_g=work_g3(2:nx_global+1,1:ny_global)
#endif
endif ! my_task = master_task
!-------------------------------------------------------------------
! optional diagnostics
!-------------------------------------------------------------------
if (my_task == master_task .and. diag) then
! write(nu_diag,*) &
! 'ice_read_global_nc, fid= ',fid, ', nrec = ',nrec, &
! ', varname = ',trim(varname)
status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar)
! write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar
do id=1,ndim
status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen)
! write(nu_diag,*) 'Dim name = ',trim(dimname),', size = ',dimlen
enddo
amin = minval(work_g)
amax = maxval(work_g, mask = work_g /= spval_dbl)
! write(nu_diag,*) 'min and max = ', amin, amax
! write(nu_diag,*) ''
write(nu_diag,*) ' read_global ',fid, varid, nrec, amin, amax
endif
#ifdef ORCA_GRID
deallocate(work_g3)
#endif
#else
work_g = c0 ! to satisfy intent(out) attribute
#endif
end subroutine ice_read_global_nc_dbl
!=======================================================================
!BOP
!
! !IROUTINE: ice_read_global_nc - read one field from a netcdf file
!
! !INTERFACE:
!
subroutine ice_read_global_nc_r4 (fid, nrec, varname, work_g, diag),3
!
! !DESCRIPTION:
!
! Read a netcdf file \\
! Just like ice_read_nc except that it returns a global array \\
! work_g is a real array
!
! !REVISION HISTORY:
! Adapted by William Lipscomb, LANL, from ice_read
! Adapted by Ann Keen, Met Office, to read from a netcdf file
!
! !USES:
!
use ice_exit
#ifdef ORCA_GRID
use ice_work, only: work_g3
#endif
!
! !INPUT/OUTPUT PARAMETERS:
!
integer (kind=int_kind), intent(in) :: &
fid , & ! file id
nrec ! record number
character (len=*), intent(in) :: &
varname ! field name in netcdf file
real (kind=real_kind), dimension(:,:), &
intent(out) :: &
work_g ! output array (real, 8-byte)
logical (kind=log_kind) :: &
diag ! if true, write diagnostic output
!
!EOP
!
#ifdef ncdf
! netCDF file diagnostics:
integer (kind=int_kind) :: &
varid, & ! netcdf id for field
status, & ! status output from netcdf routines
ndim, nvar, & ! sizes of netcdf file
id, & ! dimension index
dimlen ! size of dimension
real (kind=dbl_kind) :: &
amin, amax ! min and max values of input array
character (char_len) :: &
dimname ! dimension name
!
#ifdef ORCA_GRID
if (my_task == master_task) then
allocate(work_g3(nx_global+2,ny_global+1))
else
allocate(work_g3(1,1)) ! to save memory
endif
work_g3(:,:) = c0
#endif
work_g(:,:) = c0
if (my_task == master_task) then
!-------------------------------------------------------------
! Find out ID of required variable
!-------------------------------------------------------------
status = nf90_inq_varid(fid, trim(varname), varid)
if (status /= nf90_noerr) then
call abort_ice ( &
'ice_read_global_nc: Cannot find variable '//trim(varname) )
endif
!--------------------------------------------------------------
! Read global array
!--------------------------------------------------------------
#ifndef ORCA_GRID
status = nf90_get_var( fid, varid, work_g, &
start=(/1,1,nrec/), &
count=(/nx_global,ny_global,1/) )
#else
status = nf90_get_var( fid, varid, work_g3, &
start=(/1,1,nrec/), &
count=(/nx_global+2,ny_global+1,1/) )
work_g=work_g3(2:nx_global+1,1:ny_global)
#endif
endif ! my_task = master_task
!-------------------------------------------------------------------
! optional diagnostics
!-------------------------------------------------------------------
if (my_task == master_task .and. diag) then
! write(nu_diag,*) &
! 'ice_read_global_nc, fid= ',fid, ', nrec = ',nrec, &
! ', varname = ',trim(varname)
status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar)
! write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar
do id=1,ndim
status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen)
! write(nu_diag,*) 'Dim name = ',trim(dimname),', size = ',dimlen
enddo
amin = minval(work_g)
amax = maxval(work_g, mask = work_g /= spval_dbl)
! write(nu_diag,*) 'min and max = ', amin, amax
! write(nu_diag,*) ''
write(nu_diag,*) ' read_global ',fid, varid, nrec, amin, amax
endif
#ifdef ORCA_GRID
deallocate(work_g3)
#endif
#else
work_g = c0 ! to satisfy intent(out) attribute
#endif
end subroutine ice_read_global_nc_r4
!=======================================================================
!BOP
!
! !IROUTINE: ice_close_nc - closes a netCDF file
!
! !INTERFACE:
!
subroutine ice_close_nc(fid) 11
!
! !DESCRIPTION:
!
! Closes a netCDF file
!
! !REVISION HISTORY:
!
! author: Alison McLaren, Met Office
!
! !USES:
!
! !INPUT/OUTPUT PARAMETERS:
!
integer (kind=int_kind), intent(in) :: &
fid ! unit number
!
!EOP
!
#ifdef ncdf
integer (kind=int_kind) :: &
status ! status variable from netCDF routine
if (my_task == master_task) then
status = nf90_close(fid)
endif
#endif
end subroutine ice_close_nc
!=======================================================================
end module ice_read_write
!=======================================================================