| Class | gr_file |
| In: |
gr_file.f90
|
| Subroutine : | |
| fileid : | integer, intent(in) |
| result : | type(VSTRING), intent(out) |
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 |
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
| Derived Type : | |
| var : | character(len = 8) |
| attr : | character(len = 72) |
| value : | type(VSTRING) |
| next : | type(GR_ATTR_ENTRY), pointer |
| 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
| ||
| 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 |
| Subroutine : | |
| grfile : | type(GR_FILE_ENTRY), intent(out) |
| filename : | character(len = *), intent(in) |
| writable : | logical, intent(in) |
| mystat : | integer, intent(out) |
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