da_get_field.inc

1 subroutine da_get_field( input_file, var, field_dims, dim1, dim2, dim3,k,field)
2 
3    !-----------------------------------------------------------------------
4    ! Purpose: TBD
5    !-----------------------------------------------------------------------
6 
7    implicit none
8 
9 #include "netcdf.inc"
10    
11    character(len=200), intent(in):: input_file       ! NETCDF file nane.
12    character(len=10), intent(in) :: var              ! Variable to search for.
13    integer, intent(in)            :: field_dims       ! # Dimensions of field. 
14    integer, intent(in)            :: dim1             ! Dimension 1 of field. 
15    integer, intent(in)            :: dim2             ! Dimension 2 of field. 
16    integer, intent(in)            :: dim3             ! Dimension 3 of field. 
17    integer, intent(in)            :: k                ! Vertical index.
18    real, intent(out)              :: field(1:dim1,1:dim2) ! Output field
19 
20    integer                        :: cdfid            ! NETCDF file id.
21    integer                        :: rcode            ! Return code(0=ok).
22    integer                        :: length           ! Length of filename.
23    integer                        :: id_var           ! NETCDF variable ID. 
24 
25    integer                        :: istart(4)        ! Start value of arrays.
26    integer                        :: iend(4)          ! End value of arrays.
27    real(kind=4), allocatable     :: field2d(:,:)     ! Used if 2D field read. 
28    real(kind=4), allocatable     :: field3d(:,:,:)   ! Used if 3D field read. 
29 
30    length = len_trim(input_file)
31    rcode = nf_open( input_file(1:length), NF_NOwrite, cdfid)
32 
33    !  Check variable is in file:
34    rcode = nf_inq_varid( cdfid, var, id_var)
35    if (rcode /= 0) then
36       write(unit=message(1),fmt='(2a)')var, ' variable is not in input file'
37       call da_error(__FILE__,__LINE__,message(1:1))
38    end if
39 
40    istart = 1
41    iend(1) = dim1
42    iend(2) = dim2
43    iend(4) = 1          ! Single time assumed.
44 
45    if (field_dims == 2) then
46       iend(3) = 1
47       allocate( field2d(1:dim1,1:dim2))
48       call ncvgt( cdfid, id_var, istart, iend, field2d, rcode)
49       field(:,:) = field2d(:,:)
50       rcode = nf_close( cdfid)
51       deallocate( field2d)
52    else if (field_dims == 3) then
53       iend(3) = dim3
54       allocate( field3d(1:dim1,1:dim2,1:dim3))
55       call ncvgt( cdfid, id_var, istart, iend, field3d, rcode)
56       field(:,:) = field3d(:,:,k)
57       deallocate( field3d)
58    end if
59 
60    rcode = nf_close( cdfid)
61 
62 end subroutine da_get_field
63 
64