C ///////////////////////////////////////////////////////////////      
	 SUBROUTINE SUBDEVTEC1(STAT)
C ..........................................................Nov 2025
C Enter station site <STAT> as formal parameter
C
C ........................................................Aug. 2007 ; June 2009
C Move median calculation into separate subroutine MEDIAN.for -15 prec. days...............
C
C
C T.L.Gulyaeva .................................................Sep. 2006

C WTEC index using TECmed from -7 prec. days
C Include logarithmic scale indices -4,-3,-2,-1,0,1,2,3
C
      DIMENSION IM(12),DX(0:23),DA(16,0:23),DEV(0:23),XMED(0:23)	  !NEW
	+,IWTEC(0:23),CC(15,0:23)									  !NEW
	CHARACTER*128 INFILE1,INFILE2,OUTFILE,TXT
	CHARACTER*4 AYEAR,STAT,CYEAR,CTIME,SOUT
	CHARACTER*2 AYR,AMN,ADY,DY1,DY2,PYR,PMN,CMN,CDY
	CHARACTER(8) DD
      CHARACTER(10) TT,txt1
      CHARACTER(5) ZZ
	CHARACTER*60 listk
      DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
	COMMON /BL1/CC,XMED
      COMMON /BL2/LISTK,AYEAR,AMN,DY1,DY2,GLATK,GLONK
	
C
C    Start:
C
	      CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
	CYEAR=DD(1:4)
	CMN=DD(5:6)
	CDY=DD(7:8)
	CTIME=tt(1:4)
	txt1='WTEC-index'
	AYR=AYEAR(3:4)
C
	read(AYR,*) ryr
	IYR=int(ryr)   ! current yr
	iyri=iyr
	pyr=AYR ! prec_year
	jyr_pre=iyr

	read(AMN,*) rmn
	IMN=int(rmn)   ! current mn
	imni=imn
	jmn_pre=imn
C
	if (iyr.lt.90) then
	iyyyy=2000+iyr
	              else
	iyyyy=1900+iyr
	endif
	z1=iyyyy/4.0
      jz=int(z1)*4

      IF(jz.EQ.iyyyy) THEN
               IM(2)=29
	dnr=366.
        ELSE
                IM(2)=28
	  	dnr=365.
	       ENDIF
C
C preceding month:
C
	if (imn.gt.1) then
	jmn_pre=imn-1			 ! prec_mn
	else
	jmn_pre=12				 ! prec_mn
	jyr_pre=iyr-1			 ! prec_yr
	if (jyr_pre.lt.0) jyr_pre=100+jyr_pre ! 1998 or 1999
	call blet2(jyr_pre,PYR)  ! prec_yr
	endif
	call blet2(jmn_pre,PMN)   ! prec_mn
C
	read(DY1,*) rdy1
	idy1=int(rdy1)
	read(DY2,*) rdy2
	idy2=int(rdy2)
C
C Start for station:
C?	write(*,*) stat
200	CONTINUE
C Start from 1st day of current month
	call blet0(stat,sout)
 
      infile1='c:\web\graf\dat0\YR\statYRMNt.txt'	 ! prec. month
	      INFILE1(21:24)=sout
	 infile2=infile1  ! current mn
	     INFILE1(18:19)=pyr
	INFILE1(25:26)=pyr
	INFILE1(27:28)=pmn
	      INFILE2(18:19)=ayr
	INFILE2(25:26)=ayr
	INFILE2(27:28)=amn

            outfile='c:\web\graf\dat8\YR\statYRMNw.txt'	 ! cur. month
	      OUTFILE(21:24)=sout
	      OUTFILE(18:19)=ayr
	OUTFILE(25:26)=ayr
	OUTFILE(27:28)=amn

1100	CONTINUE
C+++
C
	      DO I=1,16					 !NEW
                   DO K=0,23
	      DA(I,K)=0.
	 enddo
	      ENDDO
C
C  =======================================================================
C
  700 format(A128)
   12	FORMAT(3I2,1X,24(F4.0,1X))
      ncnt=0        ! count of days 1,2,...,15   
      if (idy1.ge.15) goto 230	  ! goto input of current month	 !NEW

C  1st input of preceding mon-data
C  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	nndy=im(jmn_pre)	  ! prec. mn
	nnd1=nndy-13										  !NEW
      OPEN(12,FILE=INFILE1,action='READ')
	do jx=1,4
	read(12,700) TXT  ! 4 extra lines
	enddo
C
C  day-to-day input for prec mon
C
	DO 400 jdy_pre=nnd1,nndy  ! for all UT

C Reading TEC data from statyrmnt.txt file:
  59   READ (12,12,END=105,ERR=2) JYR,JMN,JDY,(DX(k),k=0,23)
	do iut=0,23
	da(16,iut)=dx(iut)									!NEW
	enddo
C
C Move data day-by-day up so that last day of month nndy=>day_27:
	do j=2,16			  ! <day-by-day				   !NEW
	do k=0,23			  ! all UT
	da(j-1,k)=da(j,k) ! move data one day up  
	enddo				  ! all UT
	enddo				  ! all days
	ncnt=ncnt+1
  400	CONTINUE		  !<day-by-day
  105	close(unit=12)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C start cycle on day-to-day for current mon  ======================================
C
  230	continue
			OPEN(12,FILE=INFILE2,action='READ')  ! current month
	do jx=1,4
	read(12,700) TXT  ! 4 extra lines
	enddo
		nndy=im(imn)	 ! end of current month
 	idy=0
C
  499	idy=idy+1	 ! day-by-day input for idy=nndy,...,idy2, current month
      lday=ndoy(iyr,imn,idy) ! function to define day-of-year
	if (idy.gt.idy2) then					  ! idy2???????????
	goto 108 ! end of day-to-day processing 
	endif
       if (idy.gt.nndy) then  !?????????????
 	idy=1
	imn=imn+1
	endif
	call blet2(idy,ADY)
	 READ (12,12,END=108,ERR=2) JYR,JMN,JDY,(DX(k),k=0,23)
	do k=0,23
	da(16,k)=dx(k)								 !NEW
	enddo
C Move data one day up: 	if(idy.lt.idy1)  
C
 	do j=2,16			  ! <day-by-day			 !NEW
	do k=0,23			  ! all UT
	da(j-1,k)=da(j,k) ! move data one day up 
	enddo				  ! all UT
	enddo				  !<day-by-day
	if (lday.ge.lday-16) ncnt=ncnt+1
		if (ncnt.lt.15) goto 499

C
      OPEN(13,FILE=OUTFILE)
32	format(A4,A60,1X,A10,2X,'glat ='F6.2,1X,'glon ='F7.2)    !txt1='WTEC-index'
		if (idy.eq.1) then
 	write(*,32) stat,listk,txt1,glatk,glonk
	write(13,32) stat,listk,txt1,glatk,glonk
	WRITE(*,18) cyear,cmn,cdy,ctime
	WRITE(13,18) cyear,cmn,cdy,ctime
		write(*,201) 
		write(13,201) 
	endif
   18	format('Date of issue: ',A4,'/',A2,'/',A2,' Time:',A4)
  201	format('YYMMDD|UT 0    1    2    3    4    5    6    7    8'
  	&'    9   10   11   12   13   14   15   16   17   18   19   20'
	&'   21   22   23'/'-------------------------------------------'
     &'-------------------------------------------------------------'
     &'------------------------')

C?	icalls=0
C?	iend=0
 
c
 	do k=0,23
	iwtec(k)=0
	xmed(k)=0.
	dev(k)=0.
	enddo

C $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
C 
  10	CONTINUE
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C  CALCULATION OF MEDIAN
C  115   for -15 prec days median
      DO J=1,15									   !NEW
        DO M=0,23          ! Hour-to-hour cycle: variable <m>
        CC(J,M)=DA(j,M)
	ENDDO
	ENDDO
	CALL RMEDIAN15(15)                             !NEW
C
C WTEC index:
C
          DO M=0,23
      XMD=XMED(M)
	xpar=CC(15,M)								  !NEW
	devlog=0.
	call windex(xpar,xmd,devlog,iw)
	DEV(M)=devlog
	IWTEC(M)=iw
	     ENDDO
C
	WRITE(*,158) ayr,amn,ady
	*,(IWTEC(K),K=0,23)
	WRITE(13,158) ayr,amn,ady
	*,(IWTEC(K),K=0,23)
 158  FORMAT(3A2,24(2X,I3))
C
C-----------------------------------
C
	 ncnt=14							!NEW
      goto 499		  ! to the next day processing
C
c
    2 CONTINUE
	       write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
	   	pause ' '
	goto 102
  108 close(unit=13)
  102	close(unit=12)
	RETURN              
	END