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=*), intent(in)  :: file
12    character (len=*),  intent(in)  :: att_name
13    logical,            intent(in)  :: debug
14    real,               intent(out) :: value
15 
16    real(kind=8)         :: tmp
17    real(kind=4)         :: tmp4
18    integer              :: cdfid, rcode, ivtype
19 
20    ! if (trace_use_dull) call da_trace_entry("da_get_gl_att_real_cdf")
21 
22    cdfid = ncopn(file, NCNOWRIT, rcode)
23 
24    if (rcode == 0) then
25      if (debug) write(unit=stdout,fmt=*) ' open netcdf file ', trim(file)
26    else
27      write(unit=stdout,fmt=*) ' error openiing netcdf file ', trim(file)
28      stop
29    end if
30 
31    rcode = NF_inQ_ATTtype(cdfid, nf_global, att_name, ivtype)
32 
33    write(unit=stdout, fmt='(a, i6)') &
34         'ivtype:', ivtype, &
35         'NF_real=', NF_real, &
36         'NF_DOUBLE=', NF_DOUBLE, &
37         'kind(value)=', kind(value)
38 
39    if ((ivtype == NF_real) .and. (kind(value) == 4)) then
40       rcode = NF_GET_ATT_real(cdfid, nf_global, att_name, value)
41    else if ((ivtype == NF_DOUBLE) .and. (kind(value) == 4)) then
42       rcode = NF_GET_ATT_real(cdfid, nf_global, att_name, tmp)
43       value = tmp
44    else if ((ivtype == NF_DOUBLE) .and. (kind(value) == 8)) then
45       rcode = NF_GET_ATT_real(cdfid, nf_global, att_name, value)
46    else if ((ivtype == NF_REAL) .and. (kind(value) == 8)) then
47       rcode = NF_GET_ATT_real(cdfid, nf_global, att_name, tmp4)
48       value = tmp4
49    else
50       write(unit=stdout, fmt='(a, i6)') &
51          'Unrecognizable ivtype:', ivtype
52       stop
53    end if
54 
55    call ncclos(cdfid,rcode)
56 
57    if (debug) write(unit=stdout,fmt=*) ' global attribute ',att_name,' is ',value
58 
59    ! if (trace_use_dull) call da_trace_exit("da_get_gl_att_real_cdf")
60 
61 end subroutine da_get_gl_att_real_cdf
62 
63