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    if (trace_use_dull) call da_trace_entry("da_get_field")
31 
32    length = len_trim(input_file)
33    rcode = nf_open( input_file(1:length), NF_NOwrite, cdfid)
34 
35    !  Check variable is in file:
36    rcode = nf_inq_varid( cdfid, var, id_var)
37    if (rcode /= 0) then
38       write(unit=message(1),fmt='(2a)')var, ' variable is not in input file'
39       call da_error(__FILE__,__LINE__,message(1:1))
40    end if
41 
42    istart = 1
43    iend(1) = dim1
44    iend(2) = dim2
45    iend(4) = 1          ! Single time assumed.
46 
47    if (field_dims == 2) then
48       iend(3) = 1
49       allocate( field2d(1:dim1,1:dim2))
50       call ncvgt( cdfid, id_var, istart, iend, field2d, rcode)
51       field(:,:) = field2d(:,:)
52       rcode = nf_close( cdfid)
53       deallocate( field2d)
54    else if (field_dims == 3) then
55       iend(3) = dim3
56       allocate( field3d(1:dim1,1:dim2,1:dim3))
57       call ncvgt( cdfid, id_var, istart, iend, field3d, rcode)
58       field(:,:) = field3d(:,:,k)
59       deallocate( field3d)
60    end if
61 
62    rcode = nf_close( cdfid)
63 
64    if (trace_use_dull) call da_trace_exit("da_get_field")
65 
66 end subroutine da_get_field
67 
68