封了个module

zhangzhipeng

FileNumber和StationNumber计算出来了，但是后面为什么崩？

[Fortran] 纯文本查看 复制代码

查看代码

打印?

001	Module SACParameter

002	Implicit None

003	Integer, parameter :: FileUnit = 100

004	Character( Len = * ), Parameter :: Directer = '"'//'..\WAV\WAVFormYiliang\yiliang\*.*'//'"'

005	Integer( kind = 4), save :: i, j, k, m, n, FileNameLong

006	Character( Len = 1 ), save :: separator

007	Character( Len = 4 ), save :: Station

008	Integer( kind = 4 ), save :: StationNumber

009	Integer( kind = 4 ), save :: FileNumber

010	Type :: EventPara

011	Character( Len = 4 ), dimension(:), allocatable :: StationName        ! 台站名数组

012	Character( Len = 4 ), dimension(:,:), allocatable :: ComponentName    ! 三分量文件名(台站,分量)

013	Character( Len = 1 ), dimension(:,:), allocatable :: stringFileName   ! 文件名信息数组二维字符数组

014	Real(kind = 4), dimension(:,:), allocatable :: StationWaveformLong    ! 重采样后的波形长度(台站,分量)

015	Real(kind = 4), dimension(:,:), allocatable :: StationMaximumAmplitude! 归一化后的最大振幅(台站,分量)

016	Real(kind = 4), dimension(:,:), allocatable :: StationDELTA           ! 重采样采样间隔(台站,分量)

017	End Type EventPara

018	Type :: SACHeader

019	Real( Kind = 4 ), Allocatable :: DELTA(:,:), DEPMIN(:,:), DEPMAX(:,:), SCALE(:,:), ODELTA(:,:), B(:,:), E(:,:),                                                                    &

020	O(:,:), A(:,:), INTERNAL1(:,:), T0(:,:), T1(:,:), T2(:,:), T3(:,:), T4(:,:), T5(:,:), T6(:,:), T7(:,:), T8(:,:), T9(:,:), F(:,:),                             &

021	RESP0(:,:),RESP1(:,:),RESP2(:,:),RESP3(:,:),RESP4(:,:),RESP5(:,:),RESP6(:,:),RESP7(:,:),RESP8(:,:),RESP9(:,:),                                                &

022	STLA(:,:),STLO(:,:),STEL(:,:),STDP(:,:),EVLA(:,:),EVLO(:,:),EVEL(:,:),EVDP(:,:),MAG(:,:),                                                                     &

023	USER0(:,:), USER1(:,:), USER2(:,:), USER3(:,:), USER4(:,:), USER5(:,:), USER6(:,:), USER7(:,:), USER8(:,:), USER9(:,:),                                       &

024	DIST(:,:), AZ(:,:), BAZ(:,:), GCARC(:,:), INTERNAL2(:,:), INTERNAL3(:,:),                                                                                     &

025	DEPMEN(:,:), CMPAZ(:,:), CMPINC(:,:), XMINIMUM(:,:), XMAXIMUM(:,:), YMINIMUM(:,:), YMAXIMUM(:,:),                                                             &

026	ADJTM(:,:), UNUSED1(:,:), UNUSED2(:,:), UNUSED3(:,:), UNUSED4(:,:), UNUSED5(:,:), UNUSED6(:,:)

027	Integer( Kind = 4 ), Allocatable :: NZYEAR(:,:), NZJDAY(:,:), NZHOUR(:,:), NZMIN(:,:), NZSEC(:,:), NZMSEC(:,:), NVHDR(:,:),                                                        &

028	NORID(:,:), NEVID(:,:), NPTS(:,:), NSPTS(:,:), NWFID(:,:), NXSIZE(:,:), NYSIZE(:,:), UNUSED7(:,:),                                                            &

029	IFTYPE(:,:), IDEP(:,:), IZTYPE(:,:), UNUSED8(:,:), IINST(:,:), ISTREG(:,:), IEVREG(:,:), IEVTYP(:,:), IQUAL(:,:), ISYNTH(:,:), IMAGTYP(:,:), IMAGSRC(:,:),    &

030	UNUSED9(:,:), UNUSED10(:,:), UNUSED11(:,:), UNUSED12(:,:), UNUSED13(:,:), UNUSED14(:,:), UNUSED15(:,:), UNUSED16(:,:),                                        &

031	LEVEN(:,:), LPSPOL(:,:), LOVROK(:,:), LCALDA(:,:), UNUSED17(:,:)

032	Character( Len = 16 ), Allocatable :: KEVNM(:,:)

033	Character( Len = 8 ), Allocatable :: KSTNM(:,:), KHOLE(:,:), KO(:,:), KA(:,:), KT0(:,:), KT1(:,:), KT2(:,:), KT3(:,:), KT4(:,:), KT5(:,:), KT6(:,:), KT7(:,:), KT8(:,:), KT9(:,:), &

034	KF(:,:), KUSER0(:,:), KUSER1(:,:), KUSER2(:,:), KCMPNM(:,:), KNETWK(:,:),  KWaveformRD(:,:), KINST(:,:)

035

036	Integer(kind = 4), dimension(:,:), Allocatable :: Header1    ! 头端一(台站,分量)

037	Real(kind = 4), dimension(:,:), Allocatable :: Header2       ! 头端二(台站,分量)

038	Character(Len = 8), dimension(:,:), Allocatable :: Header3   ! 头端三(台站,分量)

039	real( kind = 4 ), Allocatable :: Waveform(:,:,:)             ! 波形(台站,分量,记录)

040	Integer(kind = 4), Allocatable :: WaveformLong(:,:)          ! 波形长度(台站,分量)

041	End Type SACHeader

042	public FileUnit, Directer, i, j, k, m, n, FileNameLong, separator, Station, DoWithWildcard, WriteName, SplitName, EventPara, SACHeader

043	!------------------------------------------------------------------------------------------

044

Contains

045	Subroutine DoWithWildcard(cWildcard,CallBack,iTotal)

046	Use DFLib,only:GetFileInfoQQ,GetLastErrorQQ,FILE$INFO,FILE$LAST,FILE$ERROR,FILE$FIRST,ERR$NOMEM,ERR$NOENT,FILE$DIR

047	type(EventPara) :: EVENT1

048	type(SACHeader) :: SACFILE1

049

Interface

050	Subroutine CallBack( FileName , loop )

051	Character(*),Intent(In) :: FileName

052	Integer,Intent(In) :: loop

053	End Subroutine CallBack

054	End Interface

055	Character*(*),Intent(In)::cWildcard

056	Integer,Intent(Out)::iTotal

057	TYPE (FILE$INFO) info

058	INTEGER(4)::Wildhandle,length,retInt

059	Wildhandle = FILE$FIRST

060	iTotal = 0

061	DO WHILE (.TRUE.)

062	length = GetFileInfoQQ(cWildCard,info,Wildhandle)

063	IF ((Wildhandle .EQ. FILE$LAST) .OR.(Wildhandle .EQ. FILE$ERROR)) THEN

064	SELECT CASE (GetLastErrorQQ())

065	CASE (ERR$NOMEM)  !//内存不足

066	iTotal = - 1

067

Return

068	CASE (ERR$NOENT)  !//碰到通配符序列尾

069

Return

070	CASE DEFAULT

071	iTotal = 0

072

Return

073	END SELECT

074

END IF

075	If ((info%permit.AND.FILE$DIR).Eq.0) then

076	Call CallBack( Trim(info.Name) , iTotal + 1 )

077	iTotal = iTotal + 1

078

End If

079

END DO

080	End Subroutine DoWithWildcard

081

082	Subroutine WriteName( FileName , loop )

083	type(EventPara) :: EVENT1

084	type(SACHeader) :: SACFILE1

085	Character( Len = *),Intent(In) :: FileName

086	Integer,Intent(In) :: loop

087	i = Index( FileName, separator )

088	If( Station /= FileName(1:i - 1)) then

089	Station = FileName(1:i - 1)

090

j = j + 1

091

End if

092	Write(*,*) loop, Station, FileName, j

093	StationNumber = j

094	FileNumber = loop

095	End Subroutine WriteName

096

097	Subroutine SplitName( FileName , loop )

098	type(EventPara) :: EVENT1

099	type(SACHeader) :: SACFILE1

100	Character(*),Intent(In) :: FileName

101	Integer,Intent(In) :: loop

102	FileNameLong = len_trim(FileName)

103	i = Index( FileName, separator )

104	j = Index( FileName, separator, .True. )

105	If( Station /= FileName(1:j - 1)) then

106

n = n + 1

107

m = 1

108	Station = FileName(1:i - 1)

109

pause 1

110	EVENT1%StationName(n) = Station

111

pause 2

112	EVENT1%ComponentName(n,m) = FileName( j + 1:FileNameLong)

113

Else

114	EVENT1%ComponentName(n,m) = FileName( j + 1:FileNameLong)

115

m = m + 1

116

End if

117	End Subroutine SplitName

118	End module SACParameter

119	!*************************************************************************

120	Program Main

121	USE SACParameter

122	Implicit None

123	type(EventPara) :: EVENT1

124	type(SACHeader) :: SACFILE1

125	!  External WriteName, SplitName

126

127	!Character( Len = * ), Intent( In ) :: DirecterPath

128

i = 0

129

j = 0

130	separator = "."

131	Station = "AAA"

132	!Character( Len = * ), Parameter :: Path = '"'//'DirecterPath'//'"'

133	Call DoWithWildcard( '..\WAV\WAVFormYiliang\yiliang\*.*' , WriteName , N)

134	If ( N >= 0 ) then

135	Write(*,*) '共' , FileNumber , '个文件，',StationNumber,'个台站'

136

End If

137

138	Allocate(EVENT1%StationName(StationNumber))        ! 台站名数组

139	Allocate(EVENT1%ComponentName(StationNumber,3))    ! 三分量文件名(台站,分量)

140	Allocate(EVENT1%stringFileName(StationNumber,3))   ! 文件名信息数组二维字符数组

141	!Allocate(StationWaveformLong(:,:))                       ! 重采样后的波形长度(台站,分量)

142	!Allocate(StationMaximumAmplitude(:,:))                   ! 归一化后的最大振幅(台站,分量)

143	Allocate(EVENT1%StationDELTA(StationNumber,3))     ! 重采样采样间隔(台站,分量)

144

145	Allocate(SACFILE1%Header1(StationNumber,3))        ! 头端一(台站,分量)

146	Allocate(SACFILE1%Header2(StationNumber,3))        ! 头端二(台站,分量)

147	Allocate(SACFILE1%Header3(StationNumber,3))        ! 头端三(台站,分量)

148	!Allocatable(Waveform(:,:,:))                             ! 波形(台站,分量,记录)

149	Allocate(SACFILE1%WaveformLong(StationNumber,3))   ! 波形长度(台站,分量)

150

i = 0

151

j = 0

152

m = 0

153

n = 0

154	separator = "."

155	Station = "AAA"

156	Call DoWithWildcard( '..\WAV\WAVFormYiliang\yiliang\*.*' , SplitName , n )

157	Do i = 1, StationNumber

158	Write(*,*) EVENT1%StationName(i)

159	Do j = 1, FileNumber

160	Write(*,*) EVENT1%ComponentName(i,j)

161

End do

162

End do

163	End Program Main

greatzdl