	program histpch4
c .......................................................Jan 2019
C Histogram of occurrence AE,dst,aa,ap,wp max during t0+5d after Pch peak
C for 2011-2018
C
c
	DIMENSION JTHAE(5),JTHDST(5),JTHAA(5),JTHAP(5),JTHSW(5),THWP(5)
	+,rae(4),rdst(4),raa(4),rap(4),rsw(4),rwp(4),jdst(326),jae(326)
     +,jaa(326),jap(326),jsw(326),dwp(326),per(4),ires(4)
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	CHARACTER*64,infile,outfile,txt
	DATA JTHAE/0,300,500,1000,10000/ 
	DATA JTHDST/0,-30,-50,-100,-600/ 
	DATA JTHAA/0,45,70,100,600/ 
	DATA JTHAP/0,25,50,80,400/ 
	DATA THWP/3.,4.,5.,6.,10./ 
	DATA JTHSW/300,400,500,600,1000/  ! solar wind
C
	CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
      TT(5:)='      '
      WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TT
C
		  outfile='histpch4.res'
	OPEN(11,FILE=OUTFILE,ACCESS='APPEND')
C
   36	format(44X,I4,4(5X,I4),4X,F4.1)

	infile='extrpch4wp.txt'
		OPEN(10,FILE=infile,ACTION='READ')
	read(10,*) txt
 	icntot=0 ! count of dPch
	do ii=1,326
	read(10,36,end=55) jsw(ii),jae(ii),jaa(ii),jap(ii),jdst(ii)
	+,dwp(ii)
      icntot=icntot+1
	enddo      
  55  CLOSE(unit=10)
C start
	do i=1,4
	rae(i)=0.
	raa(i)=0.
	rap(i)=0.
	rdst(i)=0.
	rsw(i)=0.
	rwp(i)=0.
	enddo

C cycle on events	
	nres=0
	DO 101 ii=1,icntot
c     
	do j=1,4
C AE
	if ((jae(ii).ge.jthae(j)).and.(jae(ii).lt.jthae(j+1))) then
	rae(j)=rae(j)+1.0
C	goto 51
 	endif
C Vsw
   51 if ((jsw(ii).ge.jthsw(j)).and.(jsw(ii).lt.jthsw(j+1))) then
	rsw(j)=rsw(j)+1.0
c	goto 52
 	endif
C aa
   52	if ((jaa(ii).ge.jthaa(j)).and.(jaa(ii).lt.jthaa(j+1))) then
	raa(j)=raa(j)+1.0
c	goto 53
 	endif
C ap
   53	if ((jap(ii).ge.jthap(j)).and.(jap(ii).lt.jthap(j+1))) then
	rap(j)=rap(j)+1.0
c	goto 54
 	endif
C wp
   54	if ((dwp(ii).ge.thwp(j)).and.(dwp(ii).lt.thwp(j+1))) then
	rwp(j)=rwp(j)+1.0
c	goto 55
 	endif
C Dst
	if ((jdst(ii).le.jthdst(j)).and.(jdst(ii).gt.jthdst(j+1))) then
	rdst(j)=rdst(j)+1.0
c	goto 101
 	endif
	enddo
101	CONTINUE	   
C Output
      write(*,790) icntot
	write(11,790) icntot
	do ii=1,4
	per(ii)=rsw(ii)/icntot*100.
	ires(ii)=int(rsw(ii))
	enddo
	write(*,791) (jthsw(k),k=1,4)
	write(11,791) (jthsw(k),k=1,4)
	write(*,791) (ires(k),k=1,4)
	write(11,791) (ires(k),k=1,4)
		write(*,792) (per(k),k=1,4)
 	write(11,792) (per(k),k=1,4)
C
	do ii=1,4
	per(ii)=rae(ii)/icntot*100.
	ires(ii)=int(rae(ii))
	enddo
	write(*,791) (jthae(k),k=1,4)
	write(11,791) (jthae(k),k=1,4)
	write(*,791) (ires(k),k=1,4)
	write(11,791) (ires(k),k=1,4)
		write(*,792) (per(k),k=1,4)
 	write(11,792) (per(k),k=1,4)
C
	do ii=1,4
	per(ii)=raa(ii)/icntot*100.
	ires(ii)=int(raa(ii))
	enddo
	write(*,791) (jthaa(k),k=1,4)
	write(11,791) (jthaa(k),k=1,4)
	write(*,791) (ires(k),k=1,4)
	write(11,791) (ires(k),k=1,4)
		write(*,792) (per(k),k=1,4)
 	write(11,792) (per(k),k=1,4)
C
	do ii=1,4
	per(ii)=rap(ii)/icntot*100.
	ires(ii)=int(rap(ii))
	enddo
	write(*,791) (jthap(k),k=1,4)
	write(11,791) (jthap(k),k=1,4)
	write(*,791) (ires(k),k=1,4)
	write(11,791) (ires(k),k=1,4)
		write(*,792) (per(k),k=1,4)
 	write(11,792) (per(k),k=1,4)
C
	do ii=1,4
	per(ii)=rdst(ii)/icntot*100.
	ires(ii)=int(rdst(ii))
	enddo
	write(*,791) (jthdst(k),k=1,4)
	write(11,791) (jthdst(k),k=1,4)
	write(*,791) (ires(k),k=1,4)
	write(11,791) (ires(k),k=1,4)
		write(*,792) (per(k),k=1,4)
 	write(11,792) (per(k),k=1,4)
C
	do ii=1,4
	per(ii)=rwp(ii)/icntot*100.
	ires(ii)=int(rwp(ii))
	enddo
	write(*,793) (thwp(k),k=1,4)
	write(11,793) (thwp(k),k=1,4)
	write(*,791) (ires(k),k=1,4)
	write(11,791) (ires(k),k=1,4)
		write(*,792) (per(k),k=1,4)
 	write(11,792) (per(k),k=1,4)

 105	CONTINUE
 790  format(2X,I4)
 791  format(4(2X,I4))
  792  format(4(1X,F5.2))
  793  format(4(2X,F4.1))
c   
  800 CONTINUE             
	CLOSE(unit=11)
	goto 900
    2 CONTINUE
           write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
  900 pause ' '
      STOP
      END

