Class gr_file
In: gr_file.f90

Methods

Included Modules

dc_string dc_error netcdf_f77 dcl

Public Instance methods

Subroutine :
fileid :integer, intent(in)
result :type(VSTRING), intent(out)

[Source]

    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 :
fileid :integer, intent(out)
filename :character(len = *), intent(in)
writable :logical, intent(in), optional
overwrite :logical, intent(in), optional
stat :integer, intent(out), optional
err :logical, intent(out), optional

[Source]

    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_c=trim(filename))
        endif
    end subroutine
GR_ATTR_ENTRY
Derived Type :
var :character(len = 8)
attr :character(len = 72)
value :type(VSTRING)
next :type(GR_ATTR_ENTRY), pointer
GR_FILE_ENTRY
Derived Type :
id :integer
count :integer
writable :logical
ctlfile :type(VSTRING)
dsetfile :type(VSTRING)
next :type(GR_FILE_ENTRY), pointer
: コントロールファイル情報
title :type(VSTRING)
undef :real
: 次元変数は4つだけ
lon(:) :real, pointer
lat(:) :real, pointer
lev(:) :real, pointer
time_origin :character(len = 16)
time_unit :character(len = 2)
time_step :integer
time_count :integer
: 変数表情報
nvars :integer
varname(:) :character(len = 8), pointer
vardesc(:) :type(VSTRING), pointer
levels(:) :integer, pointer
: 属性表
attr_table :type(GR_ATTR_ENTRY), pointer
file_table_head
Variable :
file_table_head :type(GR_FILE_ENTRY), save, pointer
file_table_used
Variable :
file_table_used = .FALSE. :logical, save
Subroutine :
grfile :type(GR_FILE_ENTRY), intent(out)
filename :character(len = *), intent(in)
writable :logical, intent(in)
mystat :integer, intent(out)

[Source]

    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 

[Validate]