187
社区成员
发帖
与我相关
我的任务
分享
module GlodenGrd 用于读写Golden Surfer采用的网格文件(*.grd),其中定义了一个父类(超类) grd及三个子类 grd_DSAA,grd_DSBB, grd_DSRB (三个子类对应于三种不同的数据存储格式,详见Grd文件格式说明),并为每个类提供了两个绑定的过程(read: 用于读取文件;convert: 文件类型转换)。为便于管理代码,子类的过程存放于对应的子模块中:submodule(GlodenGrd) GlodenGrd_DSAA,submodule(GlodenGrd) GlodenGrd_DSBB,submodule(GlodenGrd) GlodenGrd_DSRB。
该代码采用面向对象(OOP)设计思想,实现了读取三种格式的通用算法,并可在任意两种格式之间进行转换。学习该代码可初探Fortran的OOP特性。用户亦可根据自身需求添加功能。
module GlodenGrd
!****************************************************************************
! 处理Grd文件
! author: LI xingwang, Chang''an university, China.
! email : lixingwang@chd.edu.cn
!****************************************************************************
implicit none
private
public read_grd
real(4), parameter:: noData = 1.71041e38
type tag
character(4):: sectionName = ''
integer(4):: sectionSize = 0
end type
!超类,抽象类
type, abstract, public:: grd
contains
procedure(sub_read), private, deferred:: read
procedure(sub_convert), public, deferred:: convert
end type
abstract interface
subroutine sub_read(this, filename)
import
implicit none
class(grd), intent(out):: this
character(*), intent(in):: filename
end subroutine
subroutine sub_convert(this, filename, fileFormat)
import
implicit none
class(grd), target, intent(in):: this
character(*), intent(in):: filename
character(4), optional, intent(in):: fileFormat
end subroutine
end interface
! Surfer 6 Text
type, public, extends(grd):: grd_DSAA
character(4):: id = 'DSAA'
integer nx, ny
real xlo, xhi, ylo, yhi, zlo, zhi
real, allocatable:: z(:,:)
contains
procedure, pass:: read => read_grd_DSAA
procedure, pass:: convert => convert_grd_DSAA
end type
! Surfer 6 Binary
type, public, extends(grd):: grd_DSBB
character(4):: id = 'DSBB'
integer(2) nx, ny
real(8) xlo, xhi, ylo, yhi, zlo, zhi
real(4), allocatable:: z(:,:)
contains
procedure, pass:: read => read_grd_DSBB
procedure, pass:: convert => convert_grd_DSBB
end type
! Surfer 7
type, public, extends(grd):: grd_DSRB
type(tag):: tHeader=tag('DSRB',4), tGrid=tag('GRID',72), tData=tag('DATA',0), tFlti=tag('FLTI',0)
character(4):: id = 'DSRB'
integer(4):: version=2
integer(4) ny, nx
real(8):: xlo, ylo, xSize, ySize, zlo, zhi, rotation=0.0, blankValue=noData
real(8), allocatable:: z(:,:)
integer(4):: nTraces=0, nVertices=0
integer(4), allocatable:: traceIndex(:,:) ! 2 × nTraces
real(8), allocatable:: verticeLoc(:,:) ! 2 × nVertices
contains
procedure, pass:: read => read_grd_DSRB
procedure, pass:: convert => convert_grd_DSRB
end type
!接口, submodule GlodenGrd_DSAA
interface
module subroutine read_grd_DSAA(this, filename)
implicit none
class(grd_DSAA), intent(out):: this
character(*), intent(in):: filename
end subroutine
module subroutine convert_grd_DSAA(this, filename, fileFormat)
implicit none
class(grd_DSAA), target, intent(in):: this
character(*), intent(in):: filename
character(4), optional, intent(in):: fileFormat
end subroutine
end interface
!接口, submodule GlodenGrd_DSBB
interface
module subroutine read_grd_DSBB(this, filename)
implicit none
class(grd_DSBB), intent(out):: this
character(*), intent(in):: filename
end subroutine
module subroutine convert_grd_DSBB(this, filename, fileFormat)
implicit none
class(grd_DSBB), target, intent(in):: this
character(*), intent(in):: filename
character(4), optional, intent(in):: fileFormat
end subroutine
end interface
!接口, submodule GlodenGrd_DSRB
interface
module subroutine read_grd_DSRB(this, filename)
implicit none
class(grd_DSRB), intent(out):: this
character(*), intent(in):: filename
end subroutine
module subroutine convert_grd_DSRB(this, filename, fileFormat)
implicit none
class(grd_DSRB), target, intent(in):: this
character(*), intent(in):: filename
character(4), optional, intent(in):: fileFormat
end subroutine
end interface
contains
!****************************************************************************
! 读取 grd 格式文件
! 输入:
! filename ... 文件名
! 输出:
! this ... 数据文件
!****************************************************************************
subroutine read_grd(this, filename)
implicit none
class(grd), pointer:: this
character(*), intent(in):: filename
character(4) fileFormat
type(grd_DSAA), pointer:: temp1
type(grd_DSBB), pointer:: temp2
type(grd_DSRB), pointer:: temp3
integer unt
open(newunit=unt,file=trim(filename),status='old',access='stream')
read(unt) fileFormat
close(unt)
select case(fileFormat)
case('DSAA')
allocate(temp1); this=>temp1
case('DSBB')
allocate(temp2); this=>temp2
case('DSRB')
allocate(temp3); this=>temp3
end select
call this%read(filename)
end subroutine
!****************************************************************************
! 将 grd 转为指定格式
! 输入:
! this ... 数据
! filename ... 输出文件名
! fileFormat ... 输出文件的格式, 忽略该参数按原格式输出
!****************************************************************************
subroutine convert_grd(this, filename, fileFormat)
implicit none
class(grd), intent(in):: this
character(*), intent(in):: filename
character(4), optional,intent(in):: fileFormat
character(4) fmt
integer(4) nx, ny, version, nTraces, nVertices
real(8) xmin, xmax, ymin, ymax, zmin, zmax, rotation, blankValue
real(8), allocatable:: z(:,:)
integer(4), allocatable:: traceIndex(:,:) ! 2 × nTraces
real(8), allocatable:: verticeLoc(:,:) ! 2 × nVertices
integer i, unt
version = 2; rotation = 0.0; blankValue = noData
nTraces=0; nVertices=0
!转为大写字母
if(present(fileFormat)) then
do concurrent (i=1:len(fileFormat))
if(fileFormat(i:i)>='a'.and.fileFormat(i:i)<='z') then
fmt(i:i) = achar( iachar(fileFormat(i:i))-32 )
else
fmt(i:i) = fileFormat(i:i)
end if
end do
end if
!提取数据
select type(this)
type is(grd_DSAA)
if(.not.present(fileFormat)) fmt = 'DSAA'
nx = this%nx; ny = this%ny
xmin = this%xlo; xmax = this%xhi
ymin = this%ylo; ymax = this%yhi
allocate(z(nx,ny)); z = this%z
zmin = minval(z); zmax = maxval(z)
type is(grd_DSBB)
if(.not.present(fileFormat)) fmt = 'DSBB'
nx = this%nx; ny = this%ny
xmin = this%xlo; xmax = this%xhi
ymin = this%ylo; ymax = this%yhi
allocate(z(nx,ny)); z = this%z
zmin = minval(z); zmax = maxval(z)
type is(grd_DSRB)
if(.not.present(fileFormat)) fmt = 'DSRB'
nx = this%nx; ny = this%ny
xmin = this%xlo; xmax = this%xlo+(this%nx-1)*this%xSize
ymin = this%ylo; ymax = this%ylo+(this%ny-1)*this%ySize
allocate(z(nx,ny)); z = this%z
zmin = minval(z); zmax = maxval(z)
version = this%version
rotation = this%rotation
blankValue = this%blankValue
nTraces = this%nTraces
nVertices = this%nVertices
if(nTraces>0.and.nVertices>0) then
allocate(traceIndex,source=this%traceIndex)
allocate(verticeLoc,source=this%verticeLoc)
else
nTraces = 0; nVertices = 0
end if
end select
!输出文件
select case(fmt)
case('DSAA')
open(newunit=unt,file=filename)
write(unt,"('DSAA')")
write(unt,"(g0,2x,g0)") nx, ny
write(unt,"(g0,2x,g0)") xmin, xmax
write(unt,"(g0,2x,g0)") ymin, ymax
write(unt,"(g0,2x,g0)") zmin, zmax
do i = 1, ny
write(unt,"(*(g0,2x))") z(:,i)
end do
close(unt)
case('DSBB')
open(newunit=unt,file=filename,access='stream')
write(unt)'DSBB'
write(unt) int(nx,2), int(ny,2)
write(unt) xmin, xmax
write(unt) ymin, ymax
write(unt) zmin, zmax
do i = 1, ny
write(unt) real(z(:,i),4)
end do
close(unt)
case('DSRB')
open(newunit=unt,file=filename,access='stream')
write(unt) 'DSRB', 4_4, version ! Header
write(unt) 'GRID', 72_4, ny, nx ! GRID
write(unt) xmin, ymin
write(unt) (xmax-xmin)/(nx-1), (ymax-ymin)/(ny-1)
write(unt) zmin, zmax
write(unt) rotation, blankValue
write(unt) 'DATA', size(z)*8, z ! DATA
if(nTraces>0.and.nVertices>0) then
write(unt) 'FLTI', 8+4*size(traceIndex)+8*size(verticeLoc) !FLTI
write(unt) nTraces, nVertices, traceIndex, verticeLoc
end if
close(unt)
end select
end subroutine
end module GlodenGrd
submodule(GlodenGrd) GlodenGrd_DSAA
implicit none
contains
!****************************************************************************
! 读取 DSAA 格式文件
! 输入:
! filename ... 文件名
! 输出:
! this ... 数据
!****************************************************************************
module subroutine read_grd_DSAA(this, filename)
implicit none
class(grd_DSAA), intent(out):: this
character(*), intent(in):: filename
integer unt
open(newunit=unt,file=trim(filename),status='old')
read(unt,*) this%id
read(unt,*) this%nx, this%ny
read(unt,*) this%xlo, this%xhi
read(unt,*) this%ylo, this%yhi
read(unt,*) this%zlo, this%zhi
if(allocated(this%z)) deallocate(this%z)
allocate(this%z(this%nx,this%ny))
read(unt,*) this%z
close(unt)
this%zlo = minval(this%z)
this%zhi = maxval(this%z)
end subroutine
!****************************************************************************
! 将 DSAA 转为指定格式
! 输入:
! this ... 数据
! filename ... 输出文件名
! fileFormat ... 输出文件的格式
!****************************************************************************
module subroutine convert_grd_DSAA(this, filename, fileFormat)
implicit none
class(grd_DSAA), target, intent(in):: this
character(*), intent(in):: filename
character(4), optional, intent(in):: fileFormat
class(grd), pointer:: pGrd
pGrd => this
if(present(fileFormat)) then
call convert_grd(pGrd, filename, fileFormat)
else
call convert_grd(pGrd, filename)
end if
end subroutine
end submodule
submodule(GlodenGrd) GlodenGrd_DSBB
implicit none
contains
!****************************************************************************
! 读取 DSBB 格式文件
! 输入:
! filename ... 文件名
! 输出:
! this ... 数据
!****************************************************************************
module subroutine read_grd_DSBB(this, filename)
implicit none
class(grd_DSBB), intent(out):: this
character(*), intent(in):: filename
integer unt
open(newunit=unt,file=trim(filename),status='old',access='stream')
read(unt) this%id
read(unt) this%nx, this%ny
read(unt) this%xlo, this%xhi
read(unt) this%ylo, this%yhi
read(unt) this%zlo, this%zhi
if(allocated(this%z)) deallocate(this%z)
allocate(this%z(this%nx,this%ny))
read(unt) this%z
close(unt)
this%zlo = minval(this%z)
this%zhi = maxval(this%z)
end subroutine
!****************************************************************************
! 将 DSBB 转为指定格式
! 输入:
! this ... 数据
! filename ... 输出文件名
! fileFormat ... 输出文件的格式
!****************************************************************************
module subroutine convert_grd_DSBB(this, filename, fileFormat)
implicit none
class(grd_DSBB), target, intent(in):: this
character(*), intent(in):: filename
character(4), optional, intent(in):: fileFormat
class(grd), pointer:: pGrd
pGrd => this
if(present(fileFormat)) then
call convert_grd(pGrd, filename, fileFormat)
else
call convert_grd(pGrd, filename)
end if
end subroutine
end submodule
submodule(GlodenGrd) GlodenGrd_DSRB
implicit none
contains
!****************************************************************************
! 读取 DSRB 格式文件
! 输入:
! filename ... 文件名
! 输出:
! this ... 数据
!****************************************************************************
module subroutine read_grd_DSRB(this, filename)
implicit none
class(grd_DSRB), intent(out):: this
character(*), intent(in):: filename
integer unt
integer(8) p, i
open(newunit=unt,file=trim(filename),status='old',access='stream')
!读取 Header section
read(unt) this%tHeader%sectionName, this%tHeader%sectionSize
read(unt) this%version
!读取 Grid section
do
read(unt) this%tGrid%sectionName, this%tGrid%sectionSize
if(this%tGrid%sectionName=='GRID') exit
inquire(unt,pos=p)
read(unt,pos=p+this%tGrid%sectionSize)
end do
read(unt) this%ny, this%nx
read(unt) this%xlo, this%ylo
read(unt) this%xSize, this%ySize
read(unt) this%zlo, this%zhi
read(unt) this%rotation, this%blankValue
!读取 Data section
read(unt) this%tData%sectionName, this%tData%sectionSize
if(allocated(this%z)) deallocate(this%z)
allocate(this%z(this%nx,this%ny))
read(unt) this%z
this%zlo = minval(this%z)
this%zhi = maxval(this%z)
!读取 Fault Info Section, 不一定存在
if(allocated(this%traceIndex)) deallocate(this%traceIndex)
if(allocated(this%verticeLoc)) deallocate(this%verticeLoc)
read(unt,pos=1) !回到文件头
p = 1
do
read(unt,pos=p,iostat=i) this%tFlti%sectionName, this%tFlti%sectionSize
if(i/=0) then
this%tFlti%sectionName = 'FLTI'
this%tFlti%sectionSize = 0
exit
end if
if(this%tFlti%sectionName=='FLTI') exit
inquire(unt,pos=p)
p = p + this%tFlti%sectionSize
end do
if(this%tFlti%sectionSize/=0) then
read(unt) this%nTraces, this%nVertices
allocate(this%traceIndex(2,this%nTraces)); allocate(this%verticeLoc(2,this%nVertices))
read(unt) this%traceIndex
read(unt) this%verticeLoc
end if
close(unt)
!白化值
select case(this%version)
case(1)
where(this%z>=this%blankValue) this%z = noData
case(2)
where(this%z==this%blankValue) this%z = noData
end select
end subroutine
!****************************************************************************
! 将 DSRB 转为指定格式
! 输入:
! this ... 数据
! filename ... 输出文件名
! fileFormat ... 输出文件的格式
!****************************************************************************
module subroutine convert_grd_DSRB(this, filename, fileFormat)
implicit none
class(grd_DSRB), target, intent(in):: this
character(*), intent(in):: filename
character(4), optional, intent(in):: fileFormat
class(grd), pointer:: pGrd
pGrd => this
if(present(fileFormat)) then
call convert_grd(pGrd, filename, fileFormat)
else
call convert_grd(pGrd, filename)
end if
end subroutine
end submodule
program Test
use GlodenGrd
implicit none
class(grd), pointer:: a
call read_grd(a, '3.grd') !读取grd文件
call a%convert('a2.grd','DSAA') !转存为 DSAA 格式文件
select type(a) !输出grd信息
type is(grd_DSRB)
write(*,"(a)") a%id
write(*,"(g0,2x,g0)") a%nx, a%ny
write(*,"(g0,2x,g0)") a%xlo, a%xlo + (a%nx-1)*a%xSize
write(*,"(g0,2x,g0)") a%ylo, a%ylo + (a%ny-1)*a%ySize
write(*,"(g0,2x,g0)") a%zlo, a%zhi
type is(grd_DSBB)
write(*,"(a)") a%id
write(*,"(g0,2x,g0)") a%nx, a%ny
write(*,"(g0,2x,g0)") a%xlo, a%xhi
write(*,"(g0,2x,g0)") a%ylo, a%yhi
write(*,"(g0,2x,g0)") a%zlo, a%zhi
type is(grd_DSAA)
write(*,"(a)") a%id
write(*,"(g0,2x,g0)") a%nx, a%ny
write(*,"(g0,2x,g0)") a%xlo, a%xhi
write(*,"(g0,2x,g0)") a%ylo, a%yhi
write(*,"(g0,2x,g0)") a%zlo, a%zhi
end select
deallocate(a) !注销内存
end program Test