da_put_var_2d_real_cdf.inc

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