! Copyright (C) GFD Dennou Club, 2001.  All rights reserved
! generator of anvargetreal, anvargetdouble, etc.

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_TRACE, ONLY: BEGINSUB, ENDSUB, MESSAGE
    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 MESSAGE('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 MESSAGE('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
