      program cal3hp0rms
C..Select best fit Kp-rms and corcoef for SHpo(SKp) 1h indices..................................Sep 2022
C
C  3 days Kp index for d-1, d(SSN=0), d+1.
C 
C
      CHARACTER*99 infile1,infile2,infilekp,outfile,txt1,txt2,txt
	CHARACTER*4 CYEAR,AYEAR
	DIMENSION xkp(0:23),ykp(0:23) ! 3 days
	+,r1(999),r2(999) ! seleced t(Kpmax)-24h : t(kpmax+23h)
C
       do i=1,999
	r1(i)=0.
	r2(i)=0.
	 enddo
	outfile='cal3kp0rms.txt'
	infilekp='d:\Apkp\kpap\kpYEAR'
	infile1='cat0skp0int.txt' !1954-2021 SSN=0, modeling set
	infile2='wules0akpd.txt' !1995-2021 SSN=0, training set
C Date for modeling
	write(*,*) ' Enter ncat1,ncat2 for modeling:'
	read(*,*) ncat1,ncat2
C
        ktest=1994  !TEMP
       CYEAR='1994' !TEMP
       OPEN(11,file=infile1,action='READ')
       OPEN(14,file=outfile,access='APPEND')
C
   26 format(A99)
   27 format(1X,F8.3,1X,I3,2(1X,I2),1X,F4.1,1X,I3,1X,F6.2,8(1X,I2)
     +,1X,I4)
   28 format(1X,F8.3,1X,I3,2(1X,I2),1X,F4.1,1X,I3,1X,F6.2,8(F3.1)
     +,1X,I4)
   29 format(1X,F8.3,1X,I3,2(1X,I2),1X,F4.1,1X,I3,2(1X,F6.2),24(1X,F3.1)
     +,1X,I4,1X,I3)
C??   29 format(1X,F8.3,1X,I3,2(1X,I2),2(1X,F4.1),1X,F6.2,1X,F4.1,1X,F6.3
C??     +,1X,F7.3,1X,F5.0,4(1X,F7.2),2(1X,I4))
   30	format(1X,F8.3,1X,I3,2(1X,I2),1X,F4.1,1X,I3,1X,F6.2,24(1X,F3.1)
     +,1X,F7.2,1X,F6.3,1X,I4)
   31	format(1X,F8.3,1X,I3,1X,F7.2,2(1X,F6.2),1X,I4)
   32	format(3I2,6X,8(F2.1))
   34 format(1X,F8.3,1X,I3,2(1X,I2),2(1X,F4.1),1X,F6.2,1X,F4.1,1X,F6.3
     +,1X,F7.3,1X,F5.0,4(1X,F7.2),1X,I4)
C
C
	ndy=0	!norm
C
C
C SSN=0 Kp events
C 
C
C
  101	read(11,28,end=59) ryear,lda,imn,idy,tkp3,kpmax,skp
     +,(xkp(k),k=8,15),nn
	 iyear=int(ryear)
	if (nn.lt.ncat1) goto 101
	if (nn.gt.ncat2) goto 59  !
C  Read Kp(xd-1),Kp(xd),Kp(xd+1)
        call blet4(iear,AYEAR)
	infilekp(16:19)=AYEAR
C
	OPEN(13,file=infilekp,action='READ')
	DO lx=1,lda-1
	read(13,32,end=49) lyr,lmn,ldy,(xkp(k),k=0,7)
	ENDDO
      read(13,32,end=49) lyr,lmn,ldy,(xkp(k),k=8,15)
	read(13,32,end=49) lyr,lmn,ldy,(xkp(k),k=16,23)
   49	close(13)
CC  Array for comparison: t(Kpmax&xd)-24h : t(Kpmax&xd)+23h
	ktx=int(tkp3-1.5)
	do kk=ktx,ktx+16
	k1=kk-ktx+1
	r1(k1)=xkp(kk)
	enddo
C
  100      lda_dev=400.
       ndy=ndy+1
	rmsmin=100.0
	cormax=0.
	shpo=1.036*skp+3.158
      write(*,29) ryear,lda,imn,idy,tkp3,kpmax,skp,shpo,(xkp(k),k=0,23)
	+,nn,ndy
      write(14,29) ryear,lda,imn,idy,tkp3,kpmax,skp,shpo,(xkp(k),k=0,23)
	+,nn,ndy
C
	OPEN(12,file=infile2,action='READ')
  102	read(12,34,end=41) yyear,klda,kmn,kdy,ytkp3,ykpmax,yskp,thpomax
     +,hpomax,shpy,apomax,sap,swu,swl,swe,mm
	 backspace(12)
	read(12,26) txt
C
C  Read Kp(yd-1),Kp(yd),Kp(yd+1)
      kyear=int(yyear)
	call blet4(kyear,AYEAR)
	infilekp(16:19)=AYEAR
	OPEN(13,file=infilekp,action='READ')
	DO lx=1,klda-1
	read(13,32,end=48) lyr,lmn,ldy,(ykp(k),k=0,7)
	ENDDO
      read(13,32,end=48) lyr,lmn,ldy,(ykp(k),k=8,15)
	read(13,32,end=48) lyr,lmn,ldy,(ykp(k),k=16,23)
   48	close(13)
C
CC  Array for comparison: t(Kpmax&yd)-24h : t(Kpmax&yd)+23h
	kty=int(tkp3-1.5)
	do kk=kty,kty+16
	k2=kk-kty+1
	r2(k2)=ykp(kk)
	enddo
C
C lda	IF ((lda.ge.klda-2).and.(lda.le.klda+2)) THEN
C	IF ((yskp.ge.skp-10.).and.(yskp.le.skp+10.)) THEN
Cnorm	IF ((yskp.ge.skp-10.).and.(yskp.le.skp+10.0).and.
	IF ((shpy.ge.shpo-20.).and.(shpy.le.shpo+20.0).and.
	+(lda.ge.klda-45).and.(lda.le.klda+45)) THEN
C
      call corcoef(16,r1,r2,corf,sf12)
C RMS	= min(abs(shpy-shpo))
C Kpmax, Rkp
      sum=0.
      DO j=1,16
	del=(r1(j)-r2(j))**2
	sum=sum+del
	           enddo
	rms=sqrt(sum/16.)
C      rms=abs(shpy-shpo)
	if (rms.lt.rmsmin) then
	rmsmin=rms
	zyear=yyear
	ldaz=klda
	zskp=yskp
	zshpo=shpy
	mmz=mm
	txt1=txt
	cor1=cormax
	endif 
C
       kdev=abs(klda-lda)
        if (corf.gt.cormax) then
	   cormax=corf
	endif
C
C+	if (kdev.lt.lda_dev) then
C++	if ((kdev.lt.lda_dev).and.(rms.lt.400.)) then
	if ((kdev.lt.lda_dev).and.(rms.lt.400.)) then
	lda_dev=kdev
	rmsl=rms
	zyearl=yyear
	ldazl=klda
	zskpl=yskp
	zshpol=shpy
	mmzl=mm
	txt2=txt
	cor2=cormax
	endif
C Output Kp-3h results
      write(*,30) yyear,klda,kmn,kdy,ytkp3,ykpmax,yskp,(ykp(k),k=0,23)
	+,rms,corf,mm
      write(14,30) yyear,klda,kmn,kdy,ytkp3,ykpmax,yskp,
	+(ykp(k),k=0,23),rms,corf,mm
C
          jn=jn+1
      GOTO 102
	                ELSE
	GOTO 102
	                ENDIF
   41 continue
      write(*,26) txt1
      write(14,26) txt1
      write(*,31) zyear,ldaz,zskp,zshpo,rmsmin,mmz
	write(14,31) zyear,ldaz,zskp,zshpo,rmsmin,mmz
      write(*,26) txt2
      write(14,26) txt2
      write(*,31) zyearl,ldazl,zskpl,zshpol,rmsl,mmzl
	write(14,31) zyearl,ldazl,zskpl,zshpol,rmsl,mmzl
   58	close(12)
      goto 101
C
   59	close(11)
C
   50	close(unit=14)
	pause ' '
	STOP
	END