var/da/da_update_bc/da_get_gl_att_real_cdf.inc

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