var/da/da_update_bc/da_get_var_3d_real_cdf.inc

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