da_put_var_2d_real_cdf.inc

1 subroutine da_put_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(in) :: 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, NCWRITE, rcode)
26 
27    if (rcode == 0) then
28       if (debug) write(unit=stdout,fmt=*) ' open netcdf file ', trim(file)
29    else
30       write(unit=stdout,fmt=*) ' error openiing netcdf file ', trim(file)
31       stop
32    end if
33 
34    id_data = ncvid(cdfid, var, rcode)
35 
36    rcode = nf_inq_var(cdfid, id_data, varnam, ivtype, ndims, dimids, natts)
37    if (debug) then
38       write(unit=stdout,fmt=*) ' number of dims for ',var,' ',ndims
39    end if
40    do i=1,ndims
41       rcode = nf_inq_dimlen(cdfid, dimids(i), idims(i))
42       if (debug) write(unit=stdout,fmt=*) ' dimension ',i,idims(i)
43    end do
44 
45    ! check the dimensions
46  
47    if ((i1 /= idims(1)) .or.  &
48       (i2 /= idims(2)) .or.  &
49       (time > idims(3))    )  then
50 
51       write(unit=stdout,fmt=*) ' error in 3d_var_real read, dimension problem '
52       write(unit=stdout,fmt=*) i1, idims(1)
53       write(unit=stdout,fmt=*) i2, idims(2)
54       write(unit=stdout,fmt=*) time, idims(3)
55       write(unit=stdout,fmt=*) ' error stop '
56       stop
57    end if
58 
59    ! get the data
60 
61    istart(1) = 1
62    iend(1) = i1
63    istart(2) = 1
64    iend(2) = i2
65    istart(3) = time
66    iend(3) = 1
67 
68    if ((ivtype == NF_real) .and. (kind(data) == 4)) then
69       call ncvpt(cdfid,id_data,istart,iend,data,rcode)
70    else if ((ivtype == NF_DOUBLE) .and. (kind(data) == 8)) then
71       tmp = data
72       call ncvpt(cdfid,id_data,istart,iend,tmp,rcode)
73    else if ((ivtype == NF_DOUBLE) .and. (kind(data) == 4)) then
74       tmp = data
75       call ncvpt(cdfid,id_data,istart,iend,tmp,rcode)
76    else if ((ivtype == NF_REAL) .and. (kind(data) == 8)) then
77       tmp4 = data
78       call ncvpt(cdfid,id_data,istart,iend,tmp4,rcode)
79    else
80       write(unit=*, fmt='(a, 4i6)') &
81          'Unrecognizable ivtype:', ivtype,nf_double,nf_real,kind(data)
82       stop
83    end if
84 
85    call ncclos(cdfid,rcode)
86 
87 end subroutine da_put_var_2d_real_cdf
88 
89