var/da/da_update_bc/da_get_var_1d_real_cdf.inc

   1 subroutine da_get_var_1d_real_cdf(file, var, data, i1, time, debug)
   2
   3    !-----------------------------------------------------------------------
   4    ! Purpose: TBD
   5    !-----------------------------------------------------------------------
   6
   7    implicit none
   8
   9 #include "netcdf.inc"
  10
  11    integer,            intent(in)  :: i1, time
  12    character (len=*),  intent(in)  :: file
  13    logical,            intent(in)  :: debug
  14    character (len=*),  intent(in)  :: var
  15    real,               intent(out) :: data(i1)
  16
  17    real(kind=8)       :: tmp(i1)
  18    real(kind=4)       :: tmp4(i1)
  19    integer            :: cdfid, rcode, id_data
  20    character (len=80) :: varnam
  21    integer            :: ndims, natts, idims(10), istart(10),iend(10), dimids(10)
  22    integer            :: i, ivtype
  23
  24    ! if (trace_use) call da_trace_entry("da_get_var_1d_real_cdf")
  25
  26    cdfid = ncopn(file, NCNOWRIT, rcode)
  27
  28    if (rcode /= 0) then
  29       write(unit=stdout, fmt='(2a)') ' error openiing netcdf file ', trim(file)
  30       stop
  31    end if
  32
  33    id_data = ncvid(cdfid, var, rcode)
  34
  35    rcode = nf_inq_var(cdfid, id_data, varnam, ivtype, ndims, dimids, natts)
  36
  37    if (debug) then
  38       write(unit=stdout, fmt='(3a,i6)') ' get_var_1d_real_cdf: dims for ',var,' ',ndims
  39    end if
  40
  41    do i=1,ndims
  42       rcode = nf_inq_dimlen(cdfid, dimids(i), idims(i))
  43       if (debug) then
  44          write(unit=stdout, fmt='(a,2i6)') ' dimension ',i,idims(i)
  45          write(unit=stdout, fmt='(a,i6)') ' ivtype=', ivtype
  46          write(unit=stdout, fmt='(a, a)') ' varnam=', trim(varnam)
  47       end if
  48    end do
  49
  50    ! check the dimensions
  51
  52    if ((i1 /= idims(1)) .or.  &
  53        (time > idims(2))    )  then
  54
  55       write(unit=stdout,fmt=*) ' error in 1d_var_real read, dimension problem '
  56       write(unit=stdout,fmt=*) i1, idims(1)
  57       write(unit=stdout,fmt=*) time, idims(2)
  58       write(unit=stdout,fmt=*) ' error stop '
  59       stop
  60    end if
  61
  62    ! get the data
  63
  64    istart(1) = 1
  65    iend(1) = i1
  66    istart(2) = time
  67    iend(2) = 1
  68
  69    if ((ivtype == NF_real) .and. (kind(data) == 4)) then
  70       call ncvgt(cdfid,id_data,istart,iend,data,rcode)
  71    else if ((ivtype == NF_DOUBLE) .and. (kind(data) == 8)) then
  72       call ncvgt(cdfid,id_data,istart,iend,data,rcode)
  73    else if ((ivtype == NF_DOUBLE) .and. (kind(data) == 4)) then
  74       call ncvgt(cdfid,id_data,istart,iend,tmp,rcode)
  75       data = tmp
  76    else if ((ivtype == NF_REAL) .and. (kind(data) == 8)) then
  77       call ncvgt(cdfid,id_data,istart,iend,tmp4,rcode)
  78       data = tmp4
  79    else
  80       write(unit=stdout, fmt='(a, i6)') &
  81          'Unrecognizable ivtype:', ivtype
  82       stop
  83    end if
  84
  85    if (debug) then
  86       write(unit=stdout, fmt='(a,e24.12)') ' Sample data=', data(1)
  87    end if
  88
  89    call ncclos(cdfid,rcode)
  90
  91    ! if (trace_use) call da_trace_exit("da_get_var_1d_real_cdf")
  92
  93 end subroutine da_get_var_1d_real_cdf