[Fortran] syntaxhighlighter_viewsource syntaxhighlighter_copycode
	module aaa
    integer,parameter::nt=1489,nl=61 
	character(len=12) filename(nt),filename1(nl)
	integer sum
	end module	
	program readdata
	use aaa
	implicit none
	character(len=8) stid
    real lon,rain,lat
	integer i,j,high
	sum=0
	open(10,file='dir.txt')
	do i=1,nt
	read(10,*) filename(i)
	enddo 
	
	open(20,file=filename(1))
	open(30,file='option.txt',form='formatted')
	do j=1,11
	read(20,*)
	enddo
100 read(20,*,end=200) stid,lon,lat,high,rain
	if((lon>97).and.(lon<109).and.(lat>26).and.(lat<35))	then
	write(30,*)  stid,lon,lat,high
	sum=sum+1
	endif
	goto 100
200 continue
	close(20)
	close(30)
	print*,sum
	
	do i=2,5
		print*,'*',i
		call writeoption(filename(i),'option.txt')
		call filetofile('option.txt','option1.txt')
	enddo
	
end	
	subroutine writeoption(name1,name2)
	use aaa
	character(len=12) name1,name2
	character(len=8) stid,stid1	
    real lon,lon1,rain,lat,lat1
	integer j,high,high1,t1,t2
	open(60,file=name1,status='old')
	do j=1,11
		read(60,*)
	enddo
	open(15,file='option1.txt',form='formatted',status='replace')
300 read(60,*,end=350) stid,lon,lat,high,rain
	t1=com1(lon,lat)
	if(t1==0)then
		goto 300
	else
		open(30,file=name2)
	400 read(30,*,end=450) stid1,lon1,lat1,high1
		t2=com2(trim(stid),trim(stid1))
		if(t2==0)then
			goto 300	
		else
			goto 400
		endif
	450 continue
		write(15,*)  stid,lon,lat,high
		close(30)
	endif
	goto 300
350 continue
    close(60)
	close(15)
	end subroutine  writeoption
	subroutine filetofile(name1,name2)
	use aaa
	implicit none
	character(len=12) name1,name2
	character(len=8) stid
    real lon,lat
	integer high,ierr
	open(30,file=trim(name1),status='old',position='append')
	open(15,file=trim(name2))
	do
		read(15,*,iostat=ierr) stid,lon,lat,high
		if(ierr/=0) exit
		write(30,*) stid,lon,lat,high
		sum=sum+1
	enddo
	close(15)
	close(30)
	print*,sum	
	end subroutine filetofile  
	function com1(a,b)
	use aaa
	real a,b
	if(((a>97).and.(a<109)).and.((b>26).and.(b<35)))	then	
		com1=1
	else
		com1=0
	endif
	end function
    function com2(x,y)
	use aaa
	character(len=8) x,y
	if(x==y)then
		com2=0
	else
		com2=1
	endif
	end function