||
今天在在编写一个自定义函数,它的目的是获得整型或者实型的所占位数,以便用于实现自动生成格式描述符。
这个自定义函数不仅可以识别不同类型(见红色字体代码),还可以将函数的计算结果作为参数传递(见蓝色字体代码)。
同样是传递内部函数,第一个例子不报错,第二个却报错,WHY??
=========================================================
第一个例子,numspace()能传递内部函数=========================================================
moduletest_numspace
implicit none
interfacenumspace
moduleprocedure numspace_i, numspace_r
!module procedure numspace_f !<<如果不注释会报错,为什么??
end interfacenumspace
contains
integerfunction numspace_i(int_number)
implicitnone
integer,intent(in)::int_number
character(len=128)::fmt
write(fmt,'(I)')int_number
numspace_i=len_trim(adjustl(fmt))
endfunction numspace_i
!BL
integerfunction numspace_r(real_number)
implicitnone
real,intent(in)::real_number
character(len=128)::fmt
write(fmt,'(F)')real_number
numspace_r=len_trim(adjustl(fmt))
endfunction numspace_r
!BL
integerfunction numspace_f(from_function)
implicitnone
interface
functionfrom_function()
endfunction
endinterface
real::real_number
character(len=128)::fmt
real_number=from_function()
write(fmt,'(F)')real_number
numspace_f=len_trim(adjustl(fmt))
endfunction numspace_f
end moduletest_numspace
program main
usetest_numspace
integer::i1=123,i2=-221
real::r1=12.3,r2=33.2
character(len=128)::fmt1
write(fmt1,'(F)')r1
write(*,*)r1,len_trim(adjustl(fmt1))
write(*,*)i1,numspace(i1)
write(*,*)r2,numspace(r2)
write(*,*)numspace(min(i1,i2))
write(*,*)numspace(max(r1,r2))
end program
=========================================================
第二个例子,numspace()完全都不能传递内部函数,外部函数没有试过。
=========================================================
program read_stream
use module1
implicit none
character(len=128)::sgyfile='xc_wtie1.sgy'
integer(kind=8),parameter:: filesize=5835496 !<<byte
integer(kind=4),parameter:: bytesPerSample=4
character(len=128)::iom='OK'
integer:: ios,mark_pos=1,i,j,k,status,imin,imax
real:: rmin,rmax
integer(kind=1),dimension(3200):: textheader !<< EBCDIC字符
integer(kind=2),dimension(80,40):: textheader1 !<< EBCDIC字符
integer(kind=2),dimension(40,80):: textheader2 !<< EBCDIC字符
integer(kind=4),dimension(3):: binheader1 !<<
integer(kind=2),dimension(24):: binheader2 !<<
integer(kind=2),dimension(170):: binheader3 !<<
real(kind=4)::sampint
integer(kind=4)::numsamps
integer(kind=4)::numtraces
real(kind=4),allocatable,dimension(:,:)::dataout
integer(kind=2),allocatable,dimension(:,:)::traceheaders
character(:),allocatable:: fmt
!==============================================================================
! 打开SEG-Y文件
!==============================================================================
open(7,file=sgyfile, &
access='stream', & !<<流访问,即按字节访问文件
form='unformatted', &
CONVERT='BIG_ENDIAN', & !<<IEEE Big Endian
iostat=ios, &
iomsg=iom)
inquire(7,pos=mark_pos)
print*,'Stream Position:',mark_pos
!==============================================================================
! step 1: 读卷头
!==============================================================================
!>>读EBCDIC字符,个字节
read(7)textheader
textheader1=reshape(textheader,(/80,40/))
!>>将有符号整数转化为无符号整数
!>> 转换规则参考《深入理解计算机系统》第二章第二节
forall(i=1:80,j=1:40,textheader1(i,j)< 0 )
textheader1(i,j)= textheader1(i,j) + 256 !<<因为有符号整数默认是用补码表示的
end forall
textheader2=transpose(textheader1)
!>>输出卷头
open(8,file='textheader_ebcdic.dat')
open(9,file='textheader_ascii.dat')
open(10,file='textheader.dat')
do i=1,40
write(8,'(80i4)')(textheader2(i,j),j=1,80)
write(9,'(80i4)')(E2A(textheader2(i,j)),j=1,80)
write(10,'(80a)')(achar(E2A(textheader2(i,j))),j=1,80)
enddo
close(8)
close(9)
close(10)
inquire(7,pos=mark_pos)
print*,'Stream Position:',mark_pos
!==============================================================================
! step 2: 读字节的二进制文件头(老格式?新格式有变化)
!==============================================================================
!>>读个字节长度的二进制数据,只有前面字节的信息有用
read(7)binheader1
!write(*,*)(binheader1(i),i=1,3)
read(7)binheader2 !<< 含有采样间隔和采样点数的信息
!write(*,*)(binheader2(i),i=1,24)
sampint = binheader2(3) / 1e6
numsamps = binheader2(5)
numtraces =(filesize-3600)/(240+bytesPerSample*numsamps)
write(*,9)numsamps,numtraces
9format('Number of Samples:',I6,/,'Numberof traces:',I6)
allocate(dataout(numsamps,numtraces),stat=status)
!write(*,10)allocated(dataout),status
!10 format('Allocated Status:',L2,I3)
allocate(traceheaders(120,numtraces),stat=status)
!write(*,10)allocated(traceheaders),status
read(7)binheader3 !<< withinusless information
inquire(7,pos=mark_pos)
print*,'Stream Position:',mark_pos
!==============================================================================
! step 3: 读每一道的数据
!==============================================================================
!>>每一道都有一个道头(240字节)和数据(采样点*4个字节)两部分组成
do i=1,numtraces
read(7)traceheaders(:,i)
!inquire(7,pos=mark_pos)
!write(*,11)i,mark_pos
!11 format('Trace ',I4,', Stream Position:',I10)
read(7)dataout(:,i)
enddo
close(7)
!==============================================================================
! step 4: 输出数据
!==============================================================================
open(7,file='traceheader.dat')
open(8,file='amplitude.dat')
imin=minval(traceheaders)
imax=maxval(traceheaders)
!write(*,*)numspace(maxval(traceheaders)) !<<出错了,WHY???
do i=1,size(traceheaders,1)
write(7,12)(traceheaders(i,j),j=1,numtraces)
12format(<size(traceheaders,1)>I<max(numspace(imin),numspace(imax))+1>)
enddo
deallocate(traceheaders)
rmin=minval(dataout)
rmax=maxval(dataout)
do i=1,numsamps
write(8,13)(dataout(i,j),j=1,numtraces)
13format(<numsamps>F<max(numspace(rmin),numspace(rmax))>.3)
enddo
deallocate(dataout)
close(7)
close(8)
endprogramread_stream
module module1
implicit none
integer,dimension(255):: E2A=(/ &
1, 2, 3,156,9,134,127,151,141,142, 11, 12, 13, 14, &
15, 16, 17, 18,19,157,133, 8,135, 24, 25,146,143, 28, &
29, 30, 31,128,129,130,131,132,10,23, 27,136,137,138, &
139,140, 5, 6,7, 144,145, 22,147,148,149,150, 4,152, &
153,154,155, 20,21,158, 26, 32,160,161,162,163,164, &
165,166,167,168,91, 46, 60, 40, 43, 33, 38,169,170, &
171,172,173,174,175,176,177,93, 36, 42, 41, 59, 94, &
45,47,178,179,180,181,182,183,184,185,124, 44, 37, &
95, 62, 63,186,187,188,189,190,191,192,193,194, 96, &
58, 35, 64, 39,61, 34, 195, 97, 98, 99,100,101,102, &
103,104,105,196,197,198,199,200,201,202,106,107,108, &
109,110,111,112,113,114,203,204,205,206,207, 208,209, &
126,115,116,117,118,119,120,121,122,210,211,212,213, &
214,215,216,217,218,219,220,221,222,223,224,225,226, &
227,228,229,230,231,123, 65, 66, 67, 68, 69, 70,71, &
72,73,232,233,234,235,236,237, 125, 74, 75, 76, 77, &
78,79,80,81,82,238,239,240,241,242,243, 92,159, 83, &
84, 85, 86, 87,88, 89, 90,244,245,246,247,248,249, &
48,49, 50, 51,52, 53, 54, 55, 56, 57,250,251,252,253,254,255/)
interface numspace
moduleprocedurenumspace_i, numspace_r
! module procedure numspace_f
end interface numspace
contains
subroutine printASCII()
implicit none
integer:: i
do i=1,256
write(*,10)i,E2A(i),char(E2A(i)),achar(i-1)
10format("E2A(",i3,")= ",i3," = ",A,' , ACHAR=',A)
enddo
end subroutine printASCII
integerfunctionnumspace_i(int_number)
implicit none
integer,intent(in)::int_number
character(len=128):: fmt
write(fmt,'(I)')int_number
numspace_i=len_trim(adjustl(fmt))
end function numspace_i
!BL
integerfunctionnumspace_r(real_number)
implicit none
real,intent(in)::real_number
character(len=128):: fmt
write(fmt,'(F)')real_number
numspace_r=len_trim(adjustl(fmt))
end function numspace_r
!BL
integerfunctionnumspace_f(from_function)
implicit none
interface
function from_function()
end function
end interface
real::real_number
character(len=128):: fmt
real_number= from_function()
write(fmt,'(F)')real_number
numspace_f=len_trim(adjustl(fmt))
end function numspace_f
! character function numspace_i(int_number)
! implicit none
! integer,intent(in)::int_number
! character(len=128):: fmt
! write(fmt,'(I)')int_number
! write(numspace_i,'')=len_trim(adjustl(fmt))
! end function numspace_i
!!BL
! character function numspace_r(real_number)
! implicit none
! real,intent(in)::real_number
! character(len=128):: fmt
! write(fmt,'(F)')real_number
! numspace_r=len_trim(adjustl(fmt))
! end function numspace_r
end module module1
Archiver|手机版|科学网 ( 京ICP备07017567号-12 )
GMT+8, 2024-10-19 23:10
Powered by ScienceNet.cn
Copyright © 2007- 中国科学报社