!---------------------------------------------------------------------
!     Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
!---------------------------------------------------------------------
!= Get AN_VARIABLES
!
! This file is created by "anvargettype.m4" by m4 command using 
! "intrinsic_types.m4". Don't edit each files directly.
!

subroutine ANVarGetReal(var, start, cnt, stride, imap, siz, value, iostat)
    use an_types,    only: AN_VARIABLE
    use an_vartable, only: AN_VARIABLE_ENTRY, vtable_lookup
    use netcdf_f77,  only: nf_noerr, nf_einval, nf_get_varm_Real, &
         &                 nf_get_var1_Real
    use dc_types,    only: DP
    use dc_trace,    only: BeginSub, EndSub, DbgMessage
    implicit none
    type(AN_VARIABLE), intent(in):: var
    integer, intent(in):: start(:)
    integer, intent(in):: cnt(:)
    integer, intent(in):: stride(:)
    integer, intent(in):: imap(:)
    integer, intent(in):: siz
    real, intent(out):: value(siz)
    integer, intent(out):: iostat
    integer:: nd, ipos, i
    type(AN_VARIABLE_ENTRY):: ent
    integer, allocatable:: istart(:), istride(:), iimap(:)
continue
    call BeginSub('ANVarGetReal', &
        & fmt='varmap=%d, start=%*d, cnt=%*d, stride=%*d, imap=%*d siz=%d', &
        & i=(/var%id, start(:), cnt(:), stride(:), imap(:), siz/), &
        & n=(/size(start), size(cnt), size(stride), size(imap)/))
    iostat = vtable_lookup(var, ent)
    if (iostat /= nf_noerr) goto 999
    ! --- nd check ---
    nd = 0
    if (associated(ent%dimids)) nd = size(ent%dimids)
    if (min(size(start), size(cnt), size(stride), size(imap)) < nd) then
        iostat = nf_einval
        goto 999
    endif
    if (nd == 0) then
        iostat = nf_get_var1_Real(ent%fileid, ent%varid, start, value(1))
        goto 999
    endif
    ! --- stride kakikae buffer ---
    allocate(istart(nd), istride(nd), iimap(nd))
    istart(1:nd) = start(1:nd)
    istride(1:nd) = stride(1:nd)
    iimap(1:nd) = imap(1:nd)
    ipos = 1
    ! --- do read ---
    if (ent%varid <= 0 .or. count(cnt(1:nd) == 1) >= 0) then
        call BeginSub('fake_map_get')
        call fake_map_get
        call EndSub('fake_map_get', 'iostat=%d', i=(/iostat/))
    else
        ! negative stride is not allowed for netcdf
        do, i = 1, nd
            if (stride(i) > 0) cycle
            ipos = ipos + (cnt(i) - 1) * imap(i)
            istart(i) = start(i) + (cnt(i) - 1) * stride(i)
            istride(i) = -stride(i)
            iimap(i) = -imap(i)
            call DbgMessage('dim %d negate: stride->%d start->%d map->%d', &
                & i=(/i, istride(i), istart(i), iimap(i)/))
        enddo
        iostat = nf_get_varm_Real(ent%fileid, ent%varid, &
            & istart, cnt, istride, iimap, value(ipos))
    endif
    deallocate(istart, istride, iimap)
999 continue
    call EndSub('ANVarGetReal', 'iostat=%d', i=(/iostat/))
    return
contains

    subroutine fake_map_get
        integer:: ofs(nd), here(nd)
        integer:: j
    continue
        iostat = nf_noerr
        ofs(1:nd) = 0
        do
            j = ipos + dot_product(ofs(1:nd), imap(1:nd))
            here(1:nd) = istart(1:nd) + ofs(1:nd) * istride(1:nd)
            if (j < 1 .or. j > siz) then
                iostat = nf_einval
                call DbgMessage('nf_get_var1_Real(ncid=%d, varid=%d,&
                    & indx=[%*d], out-ofs=%d)', &
                    & i=(/ent%fileid, ent%varid, here(1:nd), j/), n=(/nd/))
                return
            endif
            if (ent%varid == 0) then
                value(j) = j
                iostat = nf_noerr
            else
                iostat = nf_get_var1_Real(ent%fileid, ent%varid, &
                    & here(1), value(j))
            endif
            if (iostat /= nf_noerr) return
            ofs(1) = ofs(1) + 1
            do, j = 1, nd - 1
                if (ofs(j) < cnt(j)) exit
                ofs(j) = 0
                ofs(j + 1) = ofs(j + 1) + 1
            enddo
            if (ofs(nd) >= cnt(nd)) exit
        enddo
    end subroutine

end subroutine ANVarGetReal


subroutine ANVarGetDouble(var, start, cnt, stride, imap, siz, value, iostat)
    use an_types,    only: AN_VARIABLE
    use an_vartable, only: AN_VARIABLE_ENTRY, vtable_lookup
    use netcdf_f77,  only: nf_noerr, nf_einval, nf_get_varm_Double, &
         &                 nf_get_var1_Double
    use dc_types,    only: DP
    use dc_trace,    only: BeginSub, EndSub, DbgMessage
    implicit none
    type(AN_VARIABLE), intent(in):: var
    integer, intent(in):: start(:)
    integer, intent(in):: cnt(:)
    integer, intent(in):: stride(:)
    integer, intent(in):: imap(:)
    integer, intent(in):: siz
    real(DP), intent(out):: value(siz)
    integer, intent(out):: iostat
    integer:: nd, ipos, i
    type(AN_VARIABLE_ENTRY):: ent
    integer, allocatable:: istart(:), istride(:), iimap(:)
continue
    call BeginSub('ANVarGetDouble', &
        & fmt='varmap=%d, start=%*d, cnt=%*d, stride=%*d, imap=%*d siz=%d', &
        & i=(/var%id, start(:), cnt(:), stride(:), imap(:), siz/), &
        & n=(/size(start), size(cnt), size(stride), size(imap)/))
    iostat = vtable_lookup(var, ent)
    if (iostat /= nf_noerr) goto 999
    ! --- nd check ---
    nd = 0
    if (associated(ent%dimids)) nd = size(ent%dimids)
    if (min(size(start), size(cnt), size(stride), size(imap)) < nd) then
        iostat = nf_einval
        goto 999
    endif
    if (nd == 0) then
        iostat = nf_get_var1_Double(ent%fileid, ent%varid, start, value(1))
        goto 999
    endif
    ! --- stride kakikae buffer ---
    allocate(istart(nd), istride(nd), iimap(nd))
    istart(1:nd) = start(1:nd)
    istride(1:nd) = stride(1:nd)
    iimap(1:nd) = imap(1:nd)
    ipos = 1
    ! --- do read ---
    if (ent%varid <= 0 .or. count(cnt(1:nd) == 1) >= 0) then
        call BeginSub('fake_map_get')
        call fake_map_get
        call EndSub('fake_map_get', 'iostat=%d', i=(/iostat/))
    else
        ! negative stride is not allowed for netcdf
        do, i = 1, nd
            if (stride(i) > 0) cycle
            ipos = ipos + (cnt(i) - 1) * imap(i)
            istart(i) = start(i) + (cnt(i) - 1) * stride(i)
            istride(i) = -stride(i)
            iimap(i) = -imap(i)
            call DbgMessage('dim %d negate: stride->%d start->%d map->%d', &
                & i=(/i, istride(i), istart(i), iimap(i)/))
        enddo
        iostat = nf_get_varm_Double(ent%fileid, ent%varid, &
            & istart, cnt, istride, iimap, value(ipos))
    endif
    deallocate(istart, istride, iimap)
999 continue
    call EndSub('ANVarGetDouble', 'iostat=%d', i=(/iostat/))
    return
contains

    subroutine fake_map_get
        integer:: ofs(nd), here(nd)
        integer:: j
    continue
        iostat = nf_noerr
        ofs(1:nd) = 0
        do
            j = ipos + dot_product(ofs(1:nd), imap(1:nd))
            here(1:nd) = istart(1:nd) + ofs(1:nd) * istride(1:nd)
            if (j < 1 .or. j > siz) then
                iostat = nf_einval
                call DbgMessage('nf_get_var1_Double(ncid=%d, varid=%d,&
                    & indx=[%*d], out-ofs=%d)', &
                    & i=(/ent%fileid, ent%varid, here(1:nd), j/), n=(/nd/))
                return
            endif
            if (ent%varid == 0) then
                value(j) = j
                iostat = nf_noerr
            else
                iostat = nf_get_var1_Double(ent%fileid, ent%varid, &
                    & here(1), value(j))
            endif
            if (iostat /= nf_noerr) return
            ofs(1) = ofs(1) + 1
            do, j = 1, nd - 1
                if (ofs(j) < cnt(j)) exit
                ofs(j) = 0
                ofs(j + 1) = ofs(j + 1) + 1
            enddo
            if (ofs(nd) >= cnt(nd)) exit
        enddo
    end subroutine

end subroutine ANVarGetDouble

!--
! vi:set readonly sw=4 ts=8:
!
!Local Variables:
!mode: f90
!buffer-read-only: t
!End:
!
!++
