da_get_var_2d_real_cdf.inc

1 subroutine da_get_var_2d_real_cdf(file, var, data, &
2                                   i1, i2, time, debug)
3  
4    !-----------------------------------------------------------------------
5    ! Purpose: TBD
6    !-----------------------------------------------------------------------
7         
8    implicit none
9 
10 #include "netcdf.inc"
11 
12    integer, intent(in)  ::  i1, i2, time
13    character (len=80), intent(in) :: file
14    logical, intent(in) :: debug
15    character (len=*), intent(in) :: var
16    real, dimension(i1,i2), intent(out) :: data
17    real(kind=8), dimension(i1,i2) :: tmp
18    real(kind=4), dimension(i1,i2) :: tmp4
19 
20    integer cdfid, rcode, id_data
21    character (len=80) :: varnam
22    integer :: ndims, natts, idims(10), istart(10),iend(10), dimids(10)
23    integer :: i, ivtype
24 
25    cdfid = ncopn(file, NCNOWRIT, rcode)
26 
27    if (rcode /= 0) then
28       write(unit=*, fmt='(2a)') ' error openiing netcdf file ', trim(file)
29       stop
30    end if
31 
32    id_data = ncvid(cdfid, var, rcode)
33 
34    rcode = nf_inq_var(cdfid, id_data, varnam, ivtype, ndims, dimids, natts)
35 
36    if (debug) then
37       write(unit=*, fmt='(3a,i6)') ' get_var_2d_real_cdf: dims for ',var,' ',ndims
38    end if
39 
40    do i=1,ndims
41       rcode = nf_inq_dimlen(cdfid, dimids(i), idims(i))
42       if (debug) then
43          write(unit=*, fmt='(a,2i6)') ' dimension ',i,idims(i)
44          write(unit=*, fmt='(a,i6)') ' ivtype=', ivtype
45          write(unit=*, fmt='(a, a)') ' varnam=', trim(varnam)
46       end if
47    end do
48 
49    ! check the dimensions
50 
51    if ((i1 /= idims(1)) .or.  &
52        (i2 /= idims(2)) .or.  &
53        (time > idims(3))    )  then
54 
55       write(unit=stdout,fmt=*) ' error in 2d_var_real read, dimension problem '
56       write(unit=stdout,fmt=*) i1, idims(1)
57       write(unit=stdout,fmt=*) i2, idims(2)
58       write(unit=stdout,fmt=*) time, idims(4)
59       write(unit=stdout,fmt=*) ' error stop '
60       stop
61    end if
62 
63    ! get the data
64   
65    istart(1) = 1
66    iend(1) = i1
67    istart(2) = 1
68    iend(2) = i2
69    istart(3) = time
70    iend(3) = 1
71 
72    if ((ivtype == NF_real) .and. (kind(data) == 4)) then
73       call ncvgt(cdfid,id_data,istart,iend,data,rcode)
74    else if ((ivtype == NF_DOUBLE) .and. (kind(data) == 8)) then
75       call ncvgt(cdfid,id_data,istart,iend,data,rcode)
76    else if ((ivtype == NF_DOUBLE) .and. (kind(data) == 4)) then
77       call ncvgt(cdfid,id_data,istart,iend,tmp,rcode)
78       data = tmp
79    else if ((ivtype == NF_REAL) .and. (kind(data) == 8)) then
80       call ncvgt(cdfid,id_data,istart,iend,tmp4,rcode)
81       data = tmp4
82    else
83       write(unit=*, fmt='(a, i6)') &
84          'Unrecognizable ivtype:', ivtype
85       stop
86    end if
87 
88    if (debug) then
89       write(unit=*, fmt='(a,e24.12)') ' Sample data=', data(1,1)
90    end if
91 
92    call ncclos(cdfid,rcode)
93 
94 end subroutine da_get_var_2d_real_cdf
95 
96