da_get_gl_att_real_cdf.inc

1 subroutine da_get_gl_att_real_cdf(file, att_name, value, debug)
2  
3    !-----------------------------------------------------------------------
4    ! Purpose: TBD
5    !-----------------------------------------------------------------------
6         
7    implicit none
8 
9 #include "netcdf.inc"
10 
11    character (len=80), intent(in) :: file
12    character (len=*), intent(in) :: att_name
13    logical, intent(in) :: debug
14    real,    intent(out) :: value
15    real(kind=8)         :: tmp
16    real(kind=4)         :: tmp4
17 
18    integer :: cdfid, rcode, ivtype
19 
20    cdfid = ncopn(file, NCNOWRIT, rcode)
21 
22    if (rcode == 0) then
23      if (debug) write(unit=stdout,fmt=*) ' open netcdf file ', trim(file)
24    else
25      write(unit=stdout,fmt=*) ' error openiing netcdf file ', trim(file)
26      stop
27    end if
28 
29    rcode = NF_inQ_ATTtype(cdfid, nf_global, att_name, ivtype)
30 
31    write(unit=*, fmt='(a, i6)') &
32         'ivtype:', ivtype, &
33         'NF_real=', NF_real, &
34         'NF_DOUBLE=', NF_DOUBLE, &
35         'kind(value)=', kind(value)
36 
37    if ((ivtype == NF_real) .and. (kind(value) == 4)) then
38       rcode = NF_GET_ATT_real(cdfid, nf_global, att_name, value)
39    else if ((ivtype == NF_DOUBLE) .and. (kind(value) == 4)) then
40       rcode = NF_GET_ATT_real(cdfid, nf_global, att_name, tmp)
41       value = tmp
42    else if ((ivtype == NF_DOUBLE) .and. (kind(value) == 8)) then
43       rcode = NF_GET_ATT_real(cdfid, nf_global, att_name, value)
44    else if ((ivtype == NF_REAL) .and. (kind(value) == 8)) then
45       rcode = NF_GET_ATT_real(cdfid, nf_global, att_name, tmp4)
46       value = tmp4
47    else
48       write(unit=*, fmt='(a, i6)') &
49          'Unrecognizable ivtype:', ivtype
50       stop
51    end if
52 
53    call ncclos(cdfid,rcode)
54 
55    if (debug) write(unit=stdout,fmt=*) ' global attribute ',att_name,' is ',value
56 
57 end subroutine da_get_gl_att_real_cdf
58 
59