CC	
      PROGRAM PROGKPM4											   !+
C..........................................................Dec. 2014 !+
C
C Include F10.7 and sunspot number Rz indices in output file         !+
C Input:
C        /graf/YEAR/MN/yymmddmeu.txt                                 !+
C        /graf/YEAR/MN/YYMMDDfluxtable.txt (cov)                     !+
C        /graf/kpYEAR  (preceding year)                              !+
C Input=output:   /graf/kpYEAR  (current year)                       !+
C 
C..........................................................Jan. 2014
C Include both kp and ap indices in output file
C
C "KPM-T12" KPTAU12(KP12 ACCUMULATION FOR 12 PREC.HRS BY DECREASING ORDER)
C
C T.L.Gulyaeva.............................................Dec. 2009
C
      DIMENSION YYK(0:7)
     +,rxx(0:7),kp(0:7),IM(12)	 !
	+,iapf(13),iap0(0:7),iap1(0:7),iap2(0:7),iprekp(0:7),cov(0:2)      !+
	+,rzp(0:82),cvp(0:82),iapdy(0:2),ikpdy(0:2),cp(0:2),iapt(24)
	+,cv3(0:3),rz3(0:3)
	 REAL rkp(0:366,0:7),prekp(0:7)
	integer iap(0:7),irz(0:2)                                         !+
	CHARACTER*3 rz1,rz2,cov1,cov2,TMON(12),RMN_txt       !+
	CHARACTER*15 title1										          !+
	CHARACTER*2 AMN,DD2,AYR,AYR_pre,ADY_pre,AUT                           !+
	+,BYR,BMN,BDY,cyr,cmn,cdy,RDY_pre,RMN_pre,AMN_pre,RDY
	CHARACTER*4	YEAR,YEAR_pre
		CHARACTER*6 YYMMDD
C=	CHARACTER*40 put      !!! LIUBA !!!!!!!
		CHARACTER*11 put  !!! Tamara !!!!!!!
	CHARACTER*25 inkpw1  !!! LIUBA !!!!!!!
      CHARACTER*65 INKPWDC  !!! LIUBA !!!!!!! NEW
      CHARACTER*54 infile2,infilekp,infemeu,infilerz,txt,outfile         !+
	CHARACTER*6 bartdy,cartdy
	CHARACTER*45 INDATE   !!! LIUBA !!!!!!!
	CHARACTER*72 text
	COMMON /FIKP/rkp,prekp
	DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
	DATA TMON/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep'
	+,'Oct','Nov','Dec'/
C
C START:	
		icnt=0
  	ipcnt=0 ! keep cnt -82,...,-1

	  do i=0,7
	          prekp(i)=0.0
                iap0(i)=0
			  iap1(i)=0
                iap2(i)=0
                enddo
	do i=0,2
	irz(i)=0
	cov(i)=0.0
	iapdy(i)=0
	ikpdy(i)=0
	cp(i)=0.0
	enddo

      	do k=1,82
	rzp(k)=0.0
	cvp(k)=0.0
	enddo


	do j=0,366
	do i=0,7
	rkp(j,i)=0.
	enddo
	enddo

C
C  Use current year, month, day from file DATE:
C
   99	format(A4,2(1X,A2),1X,A4,2(1X,A2))
C
	indate='d:/web/graf/date'    !!! Tamara !!!!!!!
C=	indate='/var/www/izmiran/ionosphere/weather/graf/date' !!! LIUBA !!!!!!!

	open(10,file=indate)
	read(10,99) YEAR,AMN,DD2,YEAR_pre,AMN_pre,ADY_pre
C	WRITE(*,*) 'YEAR, AMN, DD2 = ',YEAR, AMN, DD2,YEAR_pre,AMN_pre,ADY_pre
	AYR=YEAR(3:4)
	close(unit=10)													  !+
	read(AYR,*) xyr
	iyr=int(xyr)
	read(amn,*) xmn
	imn=int(xmn)

	read(dd2,*) dend
	idy=int2(dend)
	idend=idy

C
      IF(iyr/4*4.eq.iyr) THEN
               IM(2)=29
					idnr=366
        ELSE
                IM(2)=28
	  	idnr=365
	       ENDIF

C
C Day-of-year:
	ldaend=ndoy(iyr,imn,idend)		  ! current day
C                                                                    !+
C
	iyr_pre=iyr-1
	call blet2(iyr_pre,AYR_pre)
	YEAR_pre(3:4)=AYR_pre
C	AYR_pre=YEAR_pre(3:4)
C	read(AYR_pre,*) ryr_pre
C	iyr_pre=int2(ryr_pre)

C	read(AMN_pre,*) xmn_pre
C	imn_pre=int2(xmn_pre)
	if (iyr_pre.lt.iyr) then
      imn_pre=12

C	read(ADY_pre,*) xdy_pre
C	idy_pre=int2(xdy_pre)
	idy_pre=365
	else
	imn_pre=imn-1
	idy_pre=im(imn_pre)
	endif
C

	lda_pre=ndoy(iyr_pre,imn_pre,idy_pre)
C
	ipre=0
	if (ldaend.lt.82) then
	  ipre=1
	endif

C Use prediction of kp-index for current day:
C
C=     put='/var/www/izmiran/ionosphere/weather/graf'	!!! LIUBA !!
       put='d:/web/graf'                              !+ Tamara
	infilerz=put									!+ Tamara
C
C 'PREDICTIONS FOR 30 Aug 2014  10CM FLUX: 122 / AP: 015'			  !+
	title1='PREDICTIONS FOR'
C
C Add input of YRMNDYmeu.txt file									  !+
	infemeu='/20YY/MN/YYMMDDmeu.txt'			    !+ Tamara
	infemeu(4:5)=AYR                                 !+ Tamara
	infemeu(7:8)=AMN                                !+ Tamara
	infemeu(10:11)=AYR                               !+ Tamara
	infemeu(12:13)=AMN                              !+ Tamara
	infemeu(14:15)=DD2                              !+ Tamara
	infilerz(12:)=infemeu							!+ Tamara
C
C Read Rz for two preceding days:
C
  111	format(A53)													 !+
	open(11,file=infilerz,action='READ')						 !+
	cov1='000'													 !+
	cov2='000'													 !+
	do 112 ii=1,400                                              !+
	read(11,111,end=123) txt									 !+
  	   IF ((txt(1:15).eq.title1).and.(txt(17:18).eq.ADY_pre)) THEN	 !+
	cov1=txt(41:43)												 !+
	if (cov1(1:1).eq.' ') cov1(1:1)='0'
	read(cov1,*) cov1n
	goto 112													 !+
	   ENDIF													 !+
	if ((txt(1:15).eq.title1).and.(txt(17:18).eq.DD2)) then		 !+
	cov2=txt(41:43)												 !+
	if (cov2(1:1).eq.' ') cov2(1:1)='0'
	read(cov2,*) cov2n
	goto 113													 !+
	endif														 !+
  112	CONTINUE													 !+
  113	do ii=1,60													 !+
	read(11,111,end=123) txt									 !+
	if (txt(1:5).eq.'TODAY') then
	rz2=txt(26:28)				! Rz for 
	exit
	endif
	enddo                                                        !+
C +rz1 for preceding day:
	do ii=1,8
	read(11,111,end=123) txt									 !+
	if (txt(1:5).eq.'SOLAR') then
	RDY_pre=txt(19:20)
	RMN_txt=txt(22:24)
	if (RDY_pre(1:1).eq.' ') RDY_pre(1:1)='0'
	read(RDY_pre,*) xrdy
	ixday=int(xrdy)+1
	call blet2(ixday,RDY)  ! next day for available Rz
	endif
	if (txt(11:13).eq.'ISN') then
	rz1=txt(26:28)			! SSN for RDY_pre
	exit					
	endif
	enddo                                                        !+
  123	close(unit=11)
	do irm=1,12
	if (RMN_txt.eq.TMON(irm)) then
	irmn=irm		   ! MN for RMN_pre
	exit
	endif
	enddo
	call blet2(irmn,RMN_pre)

C + Check absence of rz1 and/or rz2
	if((rz1(1:1).eq.'/').or.(rz1(2:2).eq.'/').or.(rz1(3:3).eq.'/')) 
	+rz1='999'
	if((rz2(1:1).eq.'/').or.(rz2(2:2).eq.'/').or.(rz2(3:3).eq.'/')) 
	+rz2='999' 
	read(rz1,*) xrz1	 ! SSN for RDY_pre
	ixrz1=int(xrz1)
	read(rz2,*) xrz2	 ! SSN for RDY=RDY_pre+1
	ixrz2=int(xrz2)
C
C Read F10.7 data file for current day:
C
	infile2='d:/web/graf/20YR/MN/yrmndyfluxtable.txt'
	infile2(15:16)=ayr
	infile2(18:19)=amn
	infile2(21:22)=ayr
	infile2(23:24)=amn
	infile2(25:26)=dd2
  20	format(2X,3A2,4X,a2,54X,F5.1)
		OPEN(12,FILE=infile2,action='READ')
	covn=70.0
	read(12,*) txt
	read(12,*) txt
  177	read(12,20,END=77,ERR=29) byr,bmn,bdy,aut,covx
crem	rz3(3)=rz*0.6
	if (aut.eq.'20') covn=covx
	goto 177
   77	close(unit=12)
	if ((byr.eq.ayr).and.(bmn.eq.amn).and.(bdy.eq.ADY_pre)) cov1n=covn ! Keep F10.7 for prec.day 
C
C Include Input file 'kpYEAR' for preceding year (for solar indices) and 'kpYEAR' for current year
C
      infilekp='d:/web/graf/kpYEAR'  !!! Tamara !!!!!!
C=       infilekp='/var/www/izmiran/ionosphere/weather/graf/kpYEAR'  !!! LIUBA !!!!!!
C
10          FORMAT(3A2,A6,8(I2),I3,8(I3),I3,F4.2,I3,F6.2)
C?10          FORMAT(3A2,A6,8(I2),I3,8(I3),I3,F4.2,I3,A6)
C
		do i=1,3
 	cvp(82)=0.0
	rzp(82)=0.0
	enddo

	if (ipre.eq.0) GOTO 203  ! avoid reading preceding year file >>>>>>>>>>>>>>>>>>
C
C For Preceding year:
	infilekp(15:18)=YEAR_pre  !!! Tamara
C=									  !+ Ljuba

	OPEN(13,FILE=infilekp,action='READ')  
  201 continue
	READ(13,10,END=202) BYR,BMN,BDY,BARTDY,(iprekp(k),k=0,7)
	+,ikpdy(0),(iap0(k),k=0,7),iapdy(0),cp(0),irz(0),cov(0)
  198	if (cov(0).lt.50.) then
	cov(0)=63.8255+0.8868*irz(0)
	endif
		rzp(82)=float(irz(0))
 	cvp(82)=cov(0)
	icnt=icnt+1
	ipcnt=ipcnt+1

	  do jj=0,7
                        iap2(jj)=iap1(jj)
                        iap1(jj)=iap0(jj)
                        enddo
	 irz(2)=irz(1)
	irz(1)=irz(0)
	cov(2)=cov(1)
	cov(1)=cov(0)
	iapdy(2)=iapdy(1)
	iapdy(1)=iapdy(0)
	ikpdy(2)=ikpdy(1)
	ikpdy(1)=ikpdy(0)
	cp(2)=cp(1)
	cp(1)=cp(0)

C Move data 1 line up:
	do k=1,82
	rzp(k-1)=rzp(k)
	cvp(k-1)=cvp(k)
	enddo
	if (ipcnt.eq.81) ipcnt=ipcnt-1
	 GOTO 201
  202	close(unit=13)
	do i=0,7
	rkp(0,i)=real(iprekp(i))/10.0
	enddo

C
C For current year:
  203	infilekp(15:18)=YEAR   !!! Tamara
C=   	infilekp(44:47)=YEAR 	 !!! LIUBA ????????
C	WRITE(*,*) 'infilekp = ',infilekp
C
	outfile=infilekp
	outfile(19:)='.txt'		 !!! Tamara
C	 outfile(                 !!! LIUBA ????????   
		OPEN(12,FILE=outfile)
		OPEN(13,FILE=infilekp)
C
C Read file kpyear for current year:
C
	iflag=0
		do i=1,3
 	cv3(i)=cvp(82)
	rz3(i)=rzp(82)
	enddo

  204 continue  
		do i=1,3
 	cv3(i-1)=cv3(i)
	rz3(i-1)=rz3(i)
	enddo

	 READ(13,10,err=139,END=205) BYR,BMN,BDY,BARTDY,(kp(k),k=0,7)
	+,ikpdy(0),(iap0(k),k=0,7),iapdy(0),cp(0),irz(0),cov(0)
	IF ((BYR.eq.AYR).and.(BMN.eq.AMN).and.(BDY.eq.DD2)) goto 205
	goto 138										   
  139	write(*,*) 'No k-index file'
	pause ' '    !!! Ljuba
      stop

  138	 do ii=0,7
	 rxx(ii)=float(kp(ii))/10.
	enddo
	if ((iflag.eq.0).and.(BMN.eq.RMN_pre).and.(BDY.eq.RDY_pre)) then
	iflag=1
	if (ixrz1.lt.999) irz(0)=ixrz1
	goto 140
	endif
	if (iflag.eq.1) then
	iflag=2
	if ((BDY.eq.RDY).and.(ixrz2.lt.999)) irz(0)=ixrz2
	cov(0)=cov1n
	endif
  140	rzp(82)=float(irz(0))
 	cvp(82)=cov(0)
	rz3(3)=rzp(82)
	cv3(3)=cvp(82)
  	  do jj=0,7	 
                        iap2(jj)=iap1(jj)
                        iap1(jj)=iap0(jj)
       iprekp(jj)=kp(jj) 
				      enddo
	 irz(2)=irz(1)
	irz(1)=irz(0)
	cov(2)=cov(1)
	cov(1)=cov(0)
	iapdy(2)=iapdy(1)
	iapdy(1)=iapdy(0)
	ikpdy(2)=ikpdy(1)
	ikpdy(1)=ikpdy(0)
	cp(2)=cp(1)
	cp(1)=cp(0)
C Move data 1 line up:
	do k=1,82
	rzp(k-1)=rzp(k)
	cvp(k-1)=cvp(k)
	enddo
C
	icnt=icnt+1
	ipcnt=ipcnt+1
	if (iflag.eq.2) goto 207
C
	isumkp=0
	do k=0,7
	isumkp=isumkp+kp(k)
	enddo
	write(*,10)  BYR,BMN,BDY,BARTDY,(kp(k),k=0,7)
 	+,isumkp,(iap0(k),k=0,7),iapdy(0),cp(0),irz(0),cov(0)
	write(12,10)  BYR,BMN,BDY,BARTDY,(kp(k),k=0,7)
 	+,isumkp,(iap0(k),k=0,7),iapdy(0),cp(0),irz(0),cov(0)

	if (ipcnt.lt.81) goto 204
                       
  207	cov81=0.
	ssn81=0.
      do k=1,81
	ssn81=ssn81+rzp(k)
	cov81=cov81+cvp(k)
	enddo
	cov81=cov81/81.
	ssn81=ssn81/81.
	covp=(cov(0)+cov(1)+cov81)/3.	!
	ssnp=(float(irz(0)+irz(1))+ssn81)/3.	!
	ipcnt=ipcnt-1
	if (iflag.lt.2) GOTO 204
  205	close(unit=13)

C
C Read file *.wdc for current month:
C
      inkpw1='/2014/12/YYMMDDqlyymm.wdc' 
	inkpw1(4:5)=AYR			!Tamara
	inkpw1(7:8)=amn 		 !Tamara
       inkpw1(10:11)=AYR		 !Tamara
	inkpw1(12:13)=amn 		 !Tamara
	inkpw1(14:15)=dd2		 !Tamara
      inkpwdc=put//inkpw1
C      WRITE(*,*) 'Put, inkpw1, inkpred = ',put, inkpw1, inkpwdc

	open(10,file=inkpwdc)
	ifl=0
   28 format(3A2,A6,8(F2.1),I3,8(I3),I3,F4.2)
	do n=0,7
		yyk(n)=0.0
	enddo

	DO 33 i=1,idend
	do n=0,7
		prekp(n)=yyk(n)
	enddo
   27 read(10,28,err=29,end=30) cyr,cmn,cdy,CARTDY,(yyk(k),k=0,7)
     +,ikpdy(0),(iap0(k),k=0,7),iapdy(0),cp(0)
	if (ifl.eq.1) goto 36
	if (cmn(1:1).eq.' ') cmn(1:1)='0'
	if (cdy(1:1).eq.' ') cdy(1:1)='0'
C+++
	if ((cyr.eq.ayr).and.(cmn.eq.amn)) then
	read(cdy,*) ydy
	idyi=int2(ydy)
	ldai=ndoy(iyr,imn,idyi)
	do n=0,7
	rkp(ldai,n)=yyk(n)
	enddo
	endif
C+++
	if ((cyr.eq.ayr).and.(cmn.eq.amn).and.(cdy.eq.ADY_pre)) then
C results for preceding day:
	isumkp=0
	do n=0,7
	kp(n)=int((yyk(n)+0.002)*10.0)
	isumkp=isumkp+kp(n)
	enddo

	write(*,10)  CYR,CMN,CDY,CARTDY,(kp(k),k=0,7)
 	+,isumkp,(iap0(k),k=0,7),iapdy(0),cp(0),irz(0),cov(0)
	write(12,10)  CYR,CMN,CDY,CARTDY,(kp(k),k=0,7)
 	+,isumkp,(iap0(k),k=0,7),iapdy(0),cp(0),irz(0),cov(0)
	goto 33
	endif
C+++
	if ((cyr.eq.ayr).and.(cmn.eq.amn).and.(cdy.eq.DD2)) then
	ifl=1
	goto 36
	                else
	goto 33
	endif
   36	continue
      read (cdy,*) xdy
	idyi=int2(xdy)
	ldai=ndoy(iyr,imn,idyi)
c-	if (ldai.ge.icnt) then      ! +++  NEW++++++++++++++++++
  	do n=0,7
  	if (yyk(n).le.9.) then
	rkp(ldai,n)=yyk(n)
	else
	call subkpm12(ldai,n) !	 produce kpm for UT=n,...,7 3h UT_bins
	do m=0,7
	akp=rkp(ldai,m)
	call subkpap(akp,iap3)
	rkp(ldai,m)=akp
	kp(m)=int2(akp)
	iap(m)=iap3
	iap0(m)=iap3
		enddo
      goto 133          ! last day
	endif
	enddo
c-	endif      ! +++++++++
  33	continue
C

C
C === collection of ap-indices for 13  3h UT bins prior to given HOUR:
C HOUR= UT specified for given day
 133	hour=0.0 ! Temp
       do jj=1,8
                iapt(jj)=iap2(jj)
                iapt(8+jj)=iap1(jj)
                iapt(16+jj)=iap0(jj)
                enddo
      if(hour.ge.24.0) hour=0.0
        ih=int(hour/3.)+1
        ihb=16+ih
        ilauf=ihb
        do jj=13,1,-1
                iapf(jj)=iapt(ilauf)
                ilauf=ilauf-1
                enddo
C
C  		OPEN(10,file=infilekp)	
C
C
	kpsum=0
	iapsum=0.0
 	do k=0,7
	kp(k)=nint(rkp(ldai,k)*10.)
	if (kp(k).eq.99) kp(k)=20
	kpsum=kpsum+kp(k)
	iapsum=iapsum+iap0(k)
	enddo
	iapsum=iapsum/8
C
		if ((CDY.eq.RDY).and.(ixrz2.lt.999)) then 
		irzn=ixrz2 ! current day from meu
	else
	irzn=nint((rz3(1)+rz3(2)+rz3(3))/3.) 
	endif

	write(*,10) AYR,AMN,DD2,cartdy,(kp(k),k=0,7) !for current day
	+,kpsum,(iap0(k),k=0,7),iapsum,cp(0),irzn,cov2n
	write(12,10) AYR,AMN,DD2,cartdy,(kp(k),k=0,7) !NEW
	+,kpsum,(iap0(k),k=0,7),iapsum,cp(0),irzn,cov2n

COLD  13  format(A6,6X,8(I2))
  13  format(A72)
C
	goto 30
  29  write(*,*) ' Error in input file ',inkpwdc
c      pause ' '
  30	close(unit=10)
	close(unit=12)
C
C
		OPEN(12,FILE=outfile,action='READ')  
		OPEN(10,FILE=infilekp)
	YYMMDD='150100'
	do k=1,ldaend+1
	read(12,13,end=134) text
	if (text(1:6).ne.YYMMDD) then
	write(10,13) text
	YYMMDD=text(1:6)
	endif
	enddo	  
  134	close(unit=10)
	close(unit=12)

C++      return
	pause ' '
  135	STOP ! Temp
      end

C
C
C
      subroutine subkpm12(nndy,nnut)
	dimension xx(16),X1(4),X2(4)
	REAL rkp(0:366,0:7),prekp(0:7)
	COMMON /FIKP/rkp,prekp
C
	 DO KUT=1,8
      XX(KUT)=RKP(nndy-1,KUT-1)
      XX(kut+8)=RKP(nndy,KUT-1)
	ENDDO 
      nut=nnut-1 ! starting UT
C cycle on UT till UT=7 (last 3h UT_bin) 
  42  DO 70 I=1,8	   ! cycle on 3h UT_bins
      RTAU=0.
	 FAK=1.
      nut=nut+1	   
      if (nut.gt.7 ) goto 71   ! return
   44 K1=9+nut  ! corresponds to nut=0 hr  + given nnut
      DO 49 N=1,4
      NK=K1-N
      X1(N)=XX(NK)	 ! 4 preceding 3h UT-bins of kp
	 X2(N)=0.
c REM PRINT NK;N;X1(N)
  49  CONTINUE !NEXT N
  50  MM=0
       DO 64 M=1,4
  52  XM=0. ! REM MAX X1(N)
  53  DO N=1,4
      IF (XM.lt.X1(N)) XM=X1(N)
        ENDDO
c REM PRINT "MAX=",XM : INPUT TTT
  57  IF(XM.eq.0.) GOTO 65
      DO 62 N=1,4
      IF(X1(N).lt.XM) GOTO 62
  60  MM=MM+1 
      X2(MM)=XM
	 X1(N)=0.
c REM PRINT "MM=";MM;X2(MM);N;X1(N) : INPUT TTT
  62  CONTINUE ! NEXT N
c REM PRINT M;X2(M);
  64  CONTINUE !NEXT M
  65  DO 69 K=1,4
c REM PRINT X2(K);
  67  RTAU=RTAU+FAK*X2(K)
  68  FAK=FAK*.7788
  69  CONTINUE !NEXT K
C      YY(I)=INT(RTAU*3.5+.5)/10
      XX(k1)=(RTAU*3.5+.5)/10.
C proxy for pred.kp:
	XX(k1)=(XX(k1)+prekp(k1-9))/2.
  70  CONTINUE ! Cycle on KUT		(720 NEXT I)
  71  do m=0,7
	rkp(nndy,m)=xx(m+9)
	enddo
  72  RETURN
c--  960 STOP	   ! temp
       END
C ===============================================================
      integer function ndoy(iyr,imn,idy)
C To define day-of-year
C
	       DIMENSION IM(0:12)
	DATA IM/31,31,28,31,30,31,30,31,31,30,31,30,31/
	nyr=iyr
	nmn=imn
	ndy=idy
	z1=nyr/4.0
      jz1=int(z1)*4
      IF(jz1.EQ.nyr) THEN
               IM(2)=29
        ELSE
                IM(2)=28
	       ENDIF
C Day-of-year LDA1
		mosum=0
C NEW++++++++++++++++++++
	if (nmn.eq.0) then
	nmn=12
	nyr=nyr-1
	if (nyr.lt.0) nyr=100+nyr
	endif
      if(nmn.gt.1) then
         do 1234 i=1,nmn-1
1234    mosum=mosum+im(i)
         endif
      ndoy=mosum+ndy	
	END FUNCTION
C ===============================================================
	  subroutine subkpap(akp,iap)
C T.L. Gulyaeva............................................Jan. 2014
C
      DIMENSION lap(0:27),ikp(0:27)
      DATA lap/0,2,3,4,5,6,7,9,12,15,18,22,27,32,39,48,56,67,80,94,111
     &,132,154,179,207,236,300,400/
      DATA ikp/0,3,7,10,13,17,20,23,27,30,33,37,40,43
     &,47,50,53,57,60,63,67,70,73,77,80,83,87,90/
C
C calculate 3h ap-indices from kp-index for current 3h UT bin
	kp10=nint(akp*10.)
C
            DO I=1,27
      IF ((KP10.GT.IKP(i-1)).AND.(KP10.LE.IKP(i))) THEN
                   iap=lap(i)
	akp=ikp(i)/10.
                   GOTO 2
               ENDIF
            ENDDO
   2  RETURN
	END
C -----------------------------------------------------------
      subroutine blet2(ilet,alet2)
c

	CHARACTER*1 IN(0:9)
	DATA IN/'0','1','2','3','4','5','6','7','8','9'/
	CHARACTER*2 alet2
	a2='00'
	j10=ilet/10
	j1=ilet-j10*10
    5	do i=0,9
	if (j10.eq.i) then
	alet2(1:1)=IN(i)
	endif
	enddo
   7	do i=0,9 
     	if (j1.eq.i) then
 	alet2(2:2)=IN(i)
	endif
	enddo 
	return
	end
C--------------------------------------------------------------------------------
C
      subroutine blet3(ilet,alet3)
c     nn=1,2,3,4 

	CHARACTER*1 IN(0:9)
	DATA IN/'0','1','2','3','4','5','6','7','8','9'/
	CHARACTER*3 alet3
c	a3='000'  !! Ljuba
C
	j100=ilet/100
	      j10=(ilet-j100*100)/10
	j1=ilet-j100*100-j10*10
    3	do i=0,9
		if (j100.eq.i) then
	alet3(1:1)=IN(i)
	endif
	enddo
    5	do i=0,9
	if (j10.eq.i) then
	alet3(2:2)=IN(i)
	endif
	enddo
   7	do i=0,9 
     	if (j1.eq.i) then
 	alet3(3:3)=IN(i)
	endif
	enddo 
	return
	end
C
C ===============================================================
