da_put_var_3d_real_cdf.inc

1 subroutine da_put_var_3d_real_cdf(file, var, data, i1, i2, i3, time, debug)
2  
3    !-----------------------------------------------------------------------
4    ! Purpose: TBD
5    !-----------------------------------------------------------------------
6         
7    implicit none
8 
9 #include "netcdf.inc"
10 
11    integer,            intent(in) ::  i1, i2, i3, 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,i3)
16 
17    real(kind=8) :: tmp(i1,i2,i3)
18    real(kind=4) :: tmp4(i1,i2,i3)
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_3d_real_cdf")
27 
28    cdfid = ncopn(file, NCWRITE, rcode)
29 
30    if (rcode /= 0) then
31       write(unit=stdout, fmt='(2a)') ' error openiing netcdf file ', trim(file)
32       stop
33    end if
34 
35    id_data = ncvid(cdfid, var, rcode)
36 
37    rcode = nf_inq_var(cdfid, id_data, varnam, ivtype, ndims, dimids, natts)
38 
39    if (debug) then
40       write(unit=stdout, fmt='(3a,i6)') ' put_var_3d_real_cdf: dims for ',var,' ',ndims
41    end if
42 
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        (i3 /= idims(3)) .or.  &
53        (time > idims(4))    )  then
54 
55       write(unit=stdout,fmt=*) ' error in 3d_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=*) i3, idims(3)
59       write(unit=stdout,fmt=*) time, idims(4)
60       write(unit=stdout,fmt=*) ' error stop '
61       stop
62    end if
63 
64    ! get the data
65   
66    istart(1) = 1
67    iend(1) = i1
68    istart(2) = 1
69    iend(2) = i2
70    istart(3) = 1
71    iend(3) = i3
72    istart(4) = time
73    iend(4) = 1
74 
75    if ((ivtype == NF_real) .and. (kind(data) == 4)) then
76       call ncvpt(cdfid,id_data,istart,iend,data,rcode)
77    else if ((ivtype == NF_DOUBLE) .and. (kind(data) == 8)) then
78       tmp = data
79       call ncvpt(cdfid,id_data,istart,iend,tmp,rcode)
80    else if ((ivtype == NF_DOUBLE) .and. (kind(data) == 4)) then
81       tmp = data
82       call ncvpt(cdfid,id_data,istart,iend,tmp,rcode)
83    else if ((ivtype == NF_REAL) .and. (kind(data) == 8)) then
84       tmp4 = data
85       call ncvpt(cdfid,id_data,istart,iend,tmp4,rcode)
86    else
87       write(unit=stdout, fmt='(a, 4i6)') &
88          'Unrecognizable ivtype:', ivtype,nf_double,nf_real,kind(data)
89       stop
90    end if
91 
92    call ncclos(cdfid,rcode)
93 
94    ! if (trace_use) call da_trace_exit("da_put_var_3d_real_cdf")
95 
96 end subroutine da_put_var_3d_real_cdf
97 
98