! Copyright (C) GFD Dennou Club, 2000.  All rights reserved
! GrADS ファイルの機能を提供

module gr_file

    use dc_string, only: VSTRING
    implicit none

    ! 属性は単連結リストで表現。
    type GR_ATTR_ENTRY
        character(len = 8):: var
        character(len = 72):: attr
        type(VSTRING):: value
        type(GR_ATTR_ENTRY), pointer:: next
    end type

    type GR_FILE_ENTRY
        integer:: id
        integer:: count
        logical:: writable
        type(VSTRING):: ctlfile
        type(VSTRING):: dsetfile
        type(GR_FILE_ENTRY), pointer:: next
        ! コントロールファイル情報
        type(VSTRING):: title
        real:: undef
        ! 次元変数は4つだけ
        real, pointer:: lon(:)
        real, pointer:: lat(:)
        real, pointer:: lev(:)
        character(len = 16):: time_origin
        character(len = 2):: time_unit
        integer:: time_step
        integer:: time_count
        ! 変数表情報
        integer:: nvars
        character(len = 8), pointer:: varname(:)
        type(VSTRING), pointer:: vardesc(:)
        integer, pointer:: levels(:)
        ! 属性表
        type(GR_ATTR_ENTRY), pointer:: attr_table
    end type

    type(GR_FILE_ENTRY), save, pointer:: file_table_head
    logical, save:: file_table_used = .FALSE.

contains

    subroutine GRFileName(fileid, result)
        use dc_string
        use dc_error
        integer, intent(in):: fileid
        type(VSTRING), intent(out):: result
        type(GR_FILE_ENTRY), pointer:: cursor
        if (.not. file_table_used) goto 999
        cursor => file_table_head
        do
            if (.not. associated(cursor)) exit
            if (cursor%id == fileid) then
                result = cursor%ctlfile
                return
            endif
            cursor => cursor%next
        enddo
        999 continue
        result = ""
        call StoreError(GR_ENOTGR, "GRFileName")
    end subroutine

    subroutine parse_ctl_file(grfile, filename, writable, mystat)
        implicit none
        type(GR_FILE_ENTRY), intent(out):: grfile
        character(len = *), intent(in):: filename
        logical, intent(in):: writable
        integer, intent(out):: mystat
        mystat = 0
        grfile%count = 1
        grfile%writable = writable
        grfile%ctlfile = filename
    end subroutine 

    subroutine GRFileOpen(fileid, filename, writable, overwrite, stat, err)
        use dc_string
        use netcdf_f77
        use dc_error
        use dcl, only: DclGetUnitNum
        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(GR_FILE_ENTRY), pointer:: cursor, prev
        integer:: mystat
        integer:: recl
        character(len = 7):: new
        character(len = 256):: dsetname
    continue
        !
        ! オプション操作
        !
        writable_required = .FALSE.
        if (present(writable)) writable_required = writable
        if (present(overwrite)) then
            writable_required = .TRUE.
            overwrite_required = overwrite
        else
            overwrite_required = .FALSE.
        endif
        !
        ! 同じ名前で書込み可能性も適合していれば open しないで済ませる
        !
        if (file_table_used) then
            cursor => file_table_head
            nullify(prev)
            do
                if ((cursor%ctlfile == filename) &
                .and. (cursor%writable .or. .not. writable_required)) &
                then
                    fileid = cursor%id
                    cursor%count = cursor%count + 1
                    if (present(err)) err = .FALSE.
                    return
                endif
                prev => cursor
                cursor => cursor%next
                if (.not. associated(cursor)) exit
            enddo
            allocate(cursor)
            prev%next => cursor
        else
            nullify(prev)
            allocate(file_table_head)
            cursor => file_table_head
            file_table_used = .TRUE.
        endif
        !
        ! ファイル表の新しく確保したエントリに書き込む
        !
        nullify(cursor%next, cursor%lat, cursor%lon, cursor%lev)
        call parse_ctl_file(cursor, filename, writable_required, mystat)
        if (mystat /= 0) goto 900
        dsetname = cursor%dsetfile

        inquire(iolength=recl) 0.0
        cursor%id = DclGetUnitNum()
        if (.not. writable_required) then
            open(unit=cursor%id, file=dsetname, access="DIRECT", &
                recl=recl, form="UNFORMATTED", status="OLD", &
                action="READ", iostat=mystat)
        else
            open(unit=cursor%id, file=dsetname, access="DIRECT", &
                recl=recl, form="UNFORMATTED", status="OLD", &
                action="READWRITE", iostat=mystat)
            if (mystat /= 0) then
                new = "NEW"
                if (overwrite_required) new = "REPLACE"
                open(unit=cursor%id, file=dsetname, access="DIRECT", &
                    recl=recl, form="UNFORMATTED", status=new, &
                    action="READWRITE", iostat=mystat)
            endif
        endif
        fileid = cursor%id

    900 continue
        ! 失敗したら GR_FILE 表から消しておく
        if (mystat /= 0) then
            if (associated(prev)) then
                prev%next => cursor%next
            else
                file_table_head => cursor%next
                if (.not. associated(file_table_head)) file_table_used = .FALSE.
            endif
            deallocate(cursor)
            fileid = -1
        endif

        if (present(stat)) then
            stat = mystat
            if (present(err)) err = (stat /= 0)
        else if (present(err)) then
            err = (stat /= 0)
        else
            call StoreError(mystat, 'GrFileOpen', err, cause_s=var_str(filename))
        endif
    end subroutine

end module