      program effpcharc
C..............................................................................Oct 2019
C Effective Pch events in Arctic and Antactic
C
C      dimension del(348),isw(348),iae(348),iaa(348),iap(348)
C	+,iwp(348),idst(348)
	CHARACTER*65 infile,outfile,txt
		CHARACTER*4 word
C	infile='extpchcat4.txt'
	infile='extpcharc4.txt'
	OPEN(10,FILE=infile,action='READ')
	read(10,*) txt !extra line
	outfile='effpch.res'
	OPEN(11,FILE=OUTFILE,access='APPEND')
C
C Thresholds correlated with Vsw=500 7 Vsw=600
C+ 	itarn1=93
C+	itarn2=262
C+ 	itarp1=112
C+	itarp2=330
C+ 	itann1=150
C+	itann2=323
C+ 	itanp1=182
C+	itanp2=372
C Thresholds 10% and 30%
C 	itarn1=100
c	itarn2=300
c 	itarp1=100
c	itarp2=300
c 	itann1=100
c	itann2=300
c 	itanp1=100
c	itanp2=300
C+ 	itarn1=193
C+	itarn2=301
C+ 	itarp1=258
C+	itarp2=338
C+ 	itann1=250
C+	itann2=374
C+ 	itanp1=300
C+	itanp2=400
 	itarn1=100
	itarn2=350
 	itarp1=100
	itarp2=450
 	itann1=100
	itann2=350
 	itanp1=100
	itanp2=450
   33 format(1X,F8.3,2(1X,I2),3(1X,F7.2),4(1X,I2,1X,I5),1X,I4)

C
	i0ann=0
      i1ann=0
	i2ann=0
	i0anp=0
      i1anp=0
	i2anp=0
	i0arn=0
      i1arn=0
	i2arn=0
	i0arp=0
      i1arp=0
	i2arp=0
C
	DO 40 ii=1,348
	read(10,33,end=50) ryear,kmn,kdy,pchmin,pchmax,dpch,nlnday,nlnmax
	+,nunday,nunmax,nlsday,nlsmax,nusday,nusmax,kev
	if (nlnmax.lt.itarn1) then
	i0arn=i0arn+1
	goto 42
	endif
	if ((nlnmax.ge.itarn1).and.(nlnmax.lt.itarn2)) then
	i1arn=i1arn+1
	                                       else
	i2arn=i2arn+1
	endif
   42	continue
	if (nunmax.lt.itarp1) then
	i0arp=i0arp+1
	goto 43
	endif
	if ((nunmax.ge.itarp1).and.(nunmax.lt.itarp2)) then
	i1arp=i1arp+1
	                                       else
	i2arp=i2arp+1
	endif
   43	continue
	if (nlsmax.lt.itann1) then
	i0ann=i0ann+1
	goto 44
	endif
	if ((nlsmax.ge.itann1).and.(nlsmax.lt.itann2)) then
	i1ann=i1ann+1
	                                       else
	i2ann=i2ann+1
	endif
   44	continue
	if (nusmax.lt.itarp1) then
	i0anp=i0anp+1
	goto 45
	endif
	if ((nusmax.ge.itanp1).and.(nusmax.lt.itanp2)) then
	i1anp=i1anp+1
	                                       else
	i2anp=i2anp+1
	endif
   45	continue
C
   40	continue ! events cycle
   50 close(unit=10)
C
C Output results
C
        word='ARn:'
      perarn0=i0arn/348.*100.
	perarn1=i1arn/348.*100.
	perarn2=i2arn/348.*100.
      write(*,30) word,i0arn,i1arn,i2arn,perarn0,perarn1,perarn2
      write(11,30) word,i0arn,i1arn,i2arn,perarn0,perarn1,perarn2
C
        word='ARp:'
      perarp0=i0arp/348.*100.
	perarp1=i1arp/348.*100.
	perarp2=i2arp/348.*100.
      write(*,30) word,i0arp,i1arp,i2arp,perarp0,perarp1,perarp2
      write(11,30) word,i0arp,i1arp,i2arp,perarp0,perarp1,perarp2
C
        word='ANn:'
      perann0=i0ann/348.*100.
	perann1=i1ann/348.*100.
	perann2=i2ann/348.*100.
      write(*,30) word,i0ann,i1ann,i2ann,perann0,perann1,perann2
      write(11,30) word,i0ann,i1ann,i2ann,perann0,perann1,perann2
C
        word='ANp:'
      peranp0=i0anp/348.*100.
	peranp1=i1anp/348.*100.
	peranp2=i2anp/348.*100.
      write(*,30) word,i0anp,i1anp,i2anp,peranp0,peranp1,peranp2
      write(11,30) word,i0anp,i1anp,i2anp,peranp0,peranp1,peranp2
   30	FORMAT(1X,A4,3(1X,I3),3(1X,F7.2))
      close(unit=11)
      pause ' '
	STOP
	END