今天在在编写一个自定义函数，它的目的是获得整型或者实型的所占位数，以便用于实现自动生成格式描述符。

这个自定义函数不仅可以识别不同类型（见红色字体代码），还可以将函数的计算结果作为参数传递（见蓝色字体代码）。

同样是传递内部函数，第一个例子不报错，第二个却报错,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