da_put_var_3d_real_cdf.inc

1 subroutine da_put_var_3d_real_cdf(file, var, data, &
2                                   i1, i2, i3, time, debug)
3  
4    !-----------------------------------------------------------------------
5    ! Purpose: TBD
6    !-----------------------------------------------------------------------
7         
8    implicit none
9 
10 #include "netcdf.inc"
11 
12    integer, intent(in)  ::  i1, i2, i3, time
13    character (len=80), intent(in) :: file
14    logical, intent(in) :: debug
15    character (len=*), intent(in) :: var
16    real, dimension(i1,i2,i3), intent(in) :: data
17    real(kind=8), dimension(i1,i2,i3) :: tmp
18    real(kind=4), dimension(i1,i2,i3) :: 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       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)') ' put_var_3d_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) 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        (i3 /= idims(3)) .or.  &
50        (time > idims(4))    )  then
51 
52       write(unit=stdout,fmt=*) ' error in 3d_var_real read, dimension problem '
53       write(unit=stdout,fmt=*) i1, idims(1)
54       write(unit=stdout,fmt=*) i2, idims(2)
55       write(unit=stdout,fmt=*) i3, idims(3)
56       write(unit=stdout,fmt=*) time, idims(4)
57       write(unit=stdout,fmt=*) ' error stop '
58       stop
59    end if
60 
61    ! get the data
62   
63    istart(1) = 1
64    iend(1) = i1
65    istart(2) = 1
66    iend(2) = i2
67    istart(3) = 1
68    iend(3) = i3
69    istart(4) = time
70    iend(4) = 1
71 
72    if ((ivtype == NF_real) .and. (kind(data) == 4)) then
73       call ncvpt(cdfid,id_data,istart,iend,data,rcode)
74    else if ((ivtype == NF_DOUBLE) .and. (kind(data) == 8)) then
75       tmp = data
76       call ncvpt(cdfid,id_data,istart,iend,tmp,rcode)
77    else if ((ivtype == NF_DOUBLE) .and. (kind(data) == 4)) then
78       tmp = data
79       call ncvpt(cdfid,id_data,istart,iend,tmp,rcode)
80    else if ((ivtype == NF_REAL) .and. (kind(data) == 8)) then
81       tmp4 = data
82       call ncvpt(cdfid,id_data,istart,iend,tmp4,rcode)
83    else
84       write(unit=*, fmt='(a, 4i6)') &
85          'Unrecognizable ivtype:', ivtype,nf_double,nf_real,kind(data)
86       stop
87    end if
88 
89    call ncclos(cdfid,rcode)
90 
91 end subroutine da_put_var_3d_real_cdf
92 
93