! Copyright (C) GFD Dennou Club, 2000.  All rights reserved

module an_file

    use dc_types, only: string
    use dc_trace, only: beginsub, endsub, message

    implicit none
    private

    type FILE_MEMO_ENTRY
        integer:: id
        integer:: count
        logical:: writable
        character(len = string):: filename
        type(FILE_MEMO_ENTRY), pointer:: next
    end type

    type(FILE_MEMO_ENTRY), save, pointer:: memo_head
    logical, save:: memo_used = .FALSE.

    public:: ANFileOpen, ANFileClose, ANFileReopen
    public:: ANFileDataMode, ANFileDefineMode, ANFileSync
    public:: Inquire

    ! 非公開なので an_generic には置かない
    interface inquire
        subroutine ANAttrInquirePlus(var, attrname, varid, nf_attrname)
            use an_types, only: AN_VARIABLE
            type(AN_VARIABLE), intent(in):: var
            character(len=*), intent(in):: attrname
            integer, intent(out):: varid
            character(len=*), intent(out):: nf_attrname
        end subroutine

        module procedure anfileinquirename
    end interface

contains

    subroutine anfileinquirename(fileid, name)
        use netcdf_f77, only: NF_ENOTNC
        use dc_error
        integer, intent(in):: fileid
        character(len = *), intent(out):: name
        type(FILE_MEMO_ENTRY), pointer:: memop
    continue
        call beginsub('anfilename', 'fileid=%d', i=(/fileid/))
        if (.not. memo_used) goto 999
        memop => memo_head
        do
            if (.not. associated(memop)) exit
            if (memop%id == fileid) then
                name = memop%filename
                call endsub('anfilename', 'name=<%c>', c1=trim(name))
                return
            endif
            memop => memop%next
        enddo
        999 continue
        call StoreError(NF_ENOTNC, "ANFileName")
        call endsub('anfilename', 'err')
    end subroutine

    subroutine ANFileSync(fileid, stat)
        use netcdf_f77, only: nf_sync, NF_NOERR
        use dc_error
        integer, intent(in), optional:: fileid
        integer, intent(out), optional:: stat
        integer:: ncid, mystat
        type(FILE_MEMO_ENTRY), pointer:: memop
        mystat = NF_NOERR
        if (present(fileid)) then
            ncid = fileid
            mystat = ANFileDataMode(ncid)
            if (mystat /= NF_NOERR) goto 999
            mystat = nf_sync(ncid)
        else if (memo_used) then
            memop => memo_head
            do
                if (.not. associated(memop)) exit
                ncid = memop%id
                mystat = ANFileDataMode(ncid)
                if (mystat /= NF_NOERR) exit
                mystat = nf_sync(ncid)
                if (mystat /= NF_NOERR) exit
                memop => memop%next
            enddo
        endif
        999 continue
        ! 自発的には StoreError しない。StoreError の SysdepAbort
        ! からも呼ばれる可能性があるためである。
        if (present(stat)) stat = mystat
    end subroutine

    subroutine ANFileOpen(fileid, filename, writable, overwrite, stat, err)
        use netcdf_f77, only: NF_WRITE, NF_NOWRITE, NF_ENOTNC, &
            NF_NOERR, NF_NOCLOBBER, NF_CLOBBER, NF_OPEN, NF_CREATE
        use dc_error, only: StoreError
        implicit none
        integer, intent(out):: fileid
        character(len = *), intent(in):: filename
        logical, intent(in), optional:: writable
        logical, intent(in), optional:: overwrite
        logical, intent(out), optional:: err
        integer, intent(out), optional:: stat
        logical:: writable_required
        logical:: overwrite_required
        type(FILE_MEMO_ENTRY), pointer:: memop, prev
        integer:: mystat, mode
        character(len = 256):: real_filename
    continue
        !
        ! オプションの解釈
        !
        writable_required = .FALSE.
        if (present(writable)) writable_required = writable
        if (present(overwrite)) then
            overwrite_required = overwrite
            if (overwrite) writable_required = .TRUE.
        else
            overwrite_required = .FALSE.
        endif
        call beginsub('anfileopen', 'writable=%y overwrite=%y file=%c', &
            & L=(/writable_required, overwrite_required/), c1=trim(filename))
        !
        ! 同じ名前で書込み可能性も適合していれば nf_open しないで済ませる
        !
        if (memo_used) then
            memop => memo_head
            nullify(prev)
            do
                if ((memop%filename == filename) &
                .and. (memop%writable .or. .not. writable_required)) then
                    fileid = memop%id
                    memop%count = memop%count + 1
                    if (present(err)) err = .FALSE.
                    if (present(stat)) stat = NF_NOERR
                    call endsub('anfileopen', 'id=%d', i=(/fileid/))
                    return
                endif
                prev => memop
                memop => memop%next
                if (.not. associated(memop)) exit
            enddo
            allocate(memop)
            prev%next => memop
        else
            nullify(prev)
            allocate(memo_head)
            memop => memo_head
            memo_used = .TRUE.
        endif
        nullify(memop%next)
        memop%filename = filename
        memop%writable = writable_required
        memop%count = 1
        !
        ! URL の部分的サポート
        !
        real_filename = filename
        if (real_filename(1:8) == 'file:///') then
            real_filename = real_filename(8: )
        else if (real_filename(1:5) == 'file:' .AND. real_filename(6:6) /= '/') then
            real_filename = real_filename(6: )
        endif
        !
        ! いざ nf_open
        !
        mode = NF_NOWRITE
        if (writable_required) mode = ior(mode, NF_WRITE)
        mystat = nf_open(real_filename, mode, memop%id)
        if (mystat /= NF_NOERR .and. writable_required) then
            mode = NF_NOCLOBBER
            if (overwrite_required) mode = NF_CLOBBER
            mystat = nf_create(real_filename, mode, memop%id)
        endif
        fileid = memop%id

        ! 失敗したら消しておく
        if (mystat /= NF_NOERR) then
            if (associated(prev)) then
                prev%next => memop%next
            else
                memo_head => memop%next
                if (.not. associated(memo_head)) memo_used = .FALSE.
            endif
            deallocate(memop)
            fileid = -1
        endif

        if (present(stat)) then
            stat = mystat
            if (present(err)) err = (stat /= NF_NOERR)
        else
            call StoreError(mystat, 'ANFileOpen', err, cause_c=filename)
        endif
        call endsub('anfileopen', 'id=%d stat=%d', i=(/fileid, mystat/))
    end subroutine

    ! 同じファイル番号の参照カウントを増加する。
    subroutine ANFileReopen(fileid, err)
        use netcdf_f77
        use dc_error, only: StoreError
        implicit none
        integer, intent(in):: fileid
        logical, intent(out), optional:: err
        type(FILE_MEMO_ENTRY), pointer:: memop
    continue
        call beginsub('anfilereopen', 'file=%d', i=(/fileid/))
        if (memo_used) then
            memop => memo_head
            do
                if (memop%id == fileid) then
                    memop%count = memop%count + 1
                    if (present(err)) err = .FALSE.
		    call endsub('anfilereopen', 'count=%d', i=(/memop%count/))
                    return
                endif
                memop => memop%next
                if (.not. associated(memop)) exit
            enddo
        endif
        call StoreError(NF_ENOTNC, 'ANFileReopen', err, cause_i=fileid)
        call endsub('anfilereopen', 'err')
    end subroutine

    ! おなじ id のファイルの参照カウンタを減算し、ゼロになったら閉じる
    subroutine ANFileClose(fileid, err)
        use netcdf_f77, only: NF_CLOSE, NF_ENOTNC, NF_NOERR
        use dc_error, only: StoreError
        integer, intent(in):: fileid
        logical, intent(out), optional:: err
        type(FILE_MEMO_ENTRY), pointer:: memop, prev
        integer:: stat
    continue
        call beginsub('anfileclose')
        stat = NF_ENOTNC
        if (.not. memo_used) goto 999
        memop => memo_head
        nullify(prev)
        do
            if (.not. associated(memop)) goto 999
            if (memop%id == fileid) exit
            prev => memop
            memop => memop%next
        enddo
        memop%count = memop%count - 1
        if (memop%count <= 0) then
            stat = nf_close(fileid)
            if (associated(prev)) then
                prev%next => memop%next
            else
                memo_head => memop%next
                if (.not. associated(memo_head)) memo_used = .FALSE.
            endif
            call message('anfileclose: <%c> closed', c1=trim(memop%filename))
            deallocate(memop)
        else
            call message('anfileclose: %d<%c> skipped for refcount=%d', &
                & c1=trim(memop%filename), i=(/fileid, memop%count/))
            stat = NF_NOERR
        endif
    999 continue
        call endsub('anfileclose')
        call StoreError(stat, 'ANFileClose', err)
    end subroutine

    integer function ANFileDefineMode(fileid) result(result)
        use netcdf_f77, only: nf_redef, NF_EINDEFINE, NF_NOERR
        integer, intent(in):: fileid
        call message('anfiledefinemode %d', i=(/fileid/))
        result = nf_redef(fileid)
        if (result == NF_EINDEFINE) result = NF_NOERR
    end function

    integer function ANFileDataMode(fileid) result(result)
        use netcdf_f77, only: nf_enddef, NF_ENOTINDEFINE, NF_NOERR
        integer, intent(in):: fileid
        call message('anfiledefinemode')
        result = nf_enddef(fileid)
        if (result == NF_ENOTINDEFINE) result = NF_NOERR
    end function

end module an_file
