CC						                                 Dec 2023
      SUBROUTINE SUBKP2018c
C T.L.Gulyaeva.............................................Sep. 2012
C Using only kpyr.txt
C
C T.L.Gulyaeva.............................................Dec. 2009
C
      DIMENSION rxx(0:7),IM(12)
     +,iprekp(0:7),icurkp(0:7)
	 REAL rkp(0:366,0:7)
C>	+,prekp(0:7)
	 integer*2 iyr,imn,idy,ID1,ID2
	CHARACTER*2 AMN,DY1,DY2,dd1,dd2,AYR
	+,CYR,CMN,CDY
	+,ADY
	CHARACTER*4	YEAR,TTT
	CHARACTER*1	Y1
	CHARACTER*36 infilekp
	CHARACTER*6 yymmdd
	CHARACTER(10) DD
	CHARACTER(5) ZZ
Cold	COMMON /FIKP/rkp,prekp
      COMMON /FIKP/icurkp,iprekp,iyear_cur,imn_cur,idy_cur !*TEST	=new
      COMMON /BL1/YEAR,AYR,AMN,DY1,DY2,DD1,DD2,ID1,ID2,ADY
       COMMON /BL2/ DD,TTT,ZZ
	DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
	
C
	CYR=DD(3:4)
	 CMN=DD(5:6)
	CDY=DD(7:8)
	iflag=1   ! for current date
	if ((CYR.eq.AYR).and.(CMN.eq.AMN).and.(CDY.eq.DY2)) goto 123
	CYR=AYR
	CMN=AMN
	CDY=DY2
	iflag=0   ! for arbitrary date
  123	DD2=DY2
	if (iflag.eq.0) goto 161   ! for arbitrary date
C Temp:
C
c//  332 format(26X,F1.0)
C
C++  161     infilekp='kpyr.txt'
C++	infilekp(3:4)=AYR        ! 
  161     infilekp='c:\web\graf\2014\kpyr.txt'
C-	if ((AYR.eq.'98').or.(AYR.eq.'99')) infilekp(13:14)='19'
	if (AYR(1:1).eq.'9') infilekp(13:14)='19'
  	infilekp(15:16)=AYR        ! 
	infilekp(20:21)=AYR        ! 
	do j=0,366
	do i=0,7
	rkp(j,i)=0.
	enddo
	enddo
C
	y1=AYR(2:2)
	read(AYR,*) ryr
	iyr=int(ryr)
	     	z1=iyr/4.0
      jz=int(z1)*4

      IF(jz.EQ.iyr) THEN
               IM(2)=29
					idnr=366
        ELSE
                IM(2)=28
	  	idnr=365
	       ENDIF

	read(amn,*) rmn
	imn=int(rmn)
	read(dd2,*) dend
	idy=int(dend)
	idend=int(dend)
C
	ldaend=ndoy(iyr,imn,idy)
	id1=idend

C
	OPEN(10,file=infilekp)
	icnt=-1
	do j=0,ldaend
	READ(10,100,err=139,end=101) yymmdd,(rxx(k),k=0,7)
  100 format(A6,6X,8(F2.1))
	goto 138
  139	write(*,*) 'No k-index file'
	pause ' '
      stop
  138 cnone=8
    	icnt=icnt+1
      do i=0,7
	if (rxx(i).gt.9.) then
	 cnone=cnone-1
	rxx(i)=10.
	endif
	rkp(j,i)=rxx(i)
	enddo
C prepare extracting UKP:
		do i=0,7
		icurkp(i)=nint(rkp(ldaend,i)*10.)
		iprekp(i)=nint(rkp(ldaend-1,i)*10.)
		enddo
C
c//	if (cnone.lt.8) then
c//	write(*,*) ' kp=99 for DOY=',j
c//	pause ' '
c//	ldaend=ldaend-1
c//	goto 101
c//	stop
c//	endif
	enddo
  101 continue
      close(unit=10)

cNOT	if ((cyr.ne.AYR).and.(CMN.ne.AMN)) goto	162
	goto 162
  30	close(unit=10)
 162     return
C  135	STOP ! Temp
      end

C
C
C ===============================================================