subroutine submedtec15
C.......................................................Nov 2024
C produce GIM-TECm for -15 prec days
C
       CHARACTER*2 AYR,AMN,ADY,AUT,AMM,PYR,PMN,PDY,CDY,AMN_pre,ADY_pre
	 CHARACTER*64 outfile,indate
		 CHARACTER*4 AYEAR,AYEAR_pre
		 CHARACTER*1 qs
      dimension CC(15,0:72),SMED(0:72),DA(0:28,0:72,71),xx(71,0:72)
	+,IM(12)
	integer*4 IRES(0:72)
	DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
C
       qs='u'  ! uqrg
Crem       qs='c'  ! uadg
C-   1        WRITE(*,*)' ENTER AYEAR (0000=stop):'
C-		READ(*,*) AYEAR
  799	format(A4,2(1X,A2),1X,A4,2(1X,A2),2(1X,I3))				 !+++
  798	format(' YEAR, AMN, ADY = ',A4,2(1X,A2),1X,A4,2(1X,A2),2(1X,I3))
	indate='c:/web/graf/date'    !!! Tamara !!!!!!!	 !FEB2015
  111	open(10,file=indate)							   !FEB2015			
	read(10,799) AYEAR,AMN,ADY,AYEAR_pre,AMN_pre,ADY_pre  !+++
	+,lda_cur,lda_pre  ! lda: day-of-year
	close(unit=10)
C
	AYR=AYEAR_pre(3:4)
       read(AYR,*) ryr
	iyr=int(ryr)
	jyr_pre=iyr
C-	      WRITE(*,*)' ENTER MN :'
C-		READ(*,*) imn
           read(AMN_pre,*) rmn
	imn=int(rmn)
	jmn_pre=imn-1
	if (jmn_pre.le.0) then
	jyr_pre=iyr-1
	jmn_pre=12
	endif
C-	call blet2(imn,AMN)
       AMN=AMN_pre
       call blet2(jyr_pre,PYR)
	call blet2(jmn_pre,PMN)
C-	      WRITE(*,*)' ENTER DY :'
C-		READ(*,*) idy
           read(ADY_pre,*) rdy
	idy=int(rdy)
	ADY=ADY_pre
C-	call blet2(idy,ADY)
C
c-	lda=ndoy(iyr,imn,idy) !temp
      lda=lda_pre
	idys=idy
	idy2=idy-1
C
	z1=iyr/4.0
      jz=int(z1)*4

      IF(jz.EQ.iyr) THEN
               IM(2)=29
        ELSE
                IM(2)=28
	       ENDIF
C++

C-      outfile='tmMMDDUTMM.uYR'  
	outfile='c:\web\graf\dtu\YR\MN\ti\tmMNDDUTMM.uYR' !! uadg med -15d
c=	if (qs.eq.'u') then
c=       outfile(15:15)='u'
C	outfile(34:34)='u'
c=	outfile(37:37)='u'
c=	                else
c=       outfile(15:15)='a'
C	outfile(34:34)='a'
c=	outfile(37:37)='a'
c=	            endif
		outfile(17:18)=AYR
	outfile(20:21)=AMN
c	outfile(25:26)=AMN
	outfile(28:29)=AMN
C	outfile(27:28)=ADY
	outfile(30:31)=ADY
C	outfile(35:36)=AYR
c=      	outfile(36:36)='.' 
      	outfile(38:39)=AYR 

C
200   continue	  
C?	idy1=idys
C
C  Start cycle on UT		=======================================================================
C
C     	 infile1='c:\web\dtm\YY\MM\tcMMDDUTMM.jYY'   ! preceding mn
         iutend=23
	iutcur=iutend
C
      DO 300 iut=0,iutend
	call blet2(iut,AUT)
c	outfile(29:30)=AUT
	outfile(32:33)=AUT
	ut=float(iut)
	immend=45
C
      DO 301 imm=0,immend,15
	call blet2(imm,AMM)
c	outfile(31:32)=AMM
	outfile(34:35)=AMM
C
	 DO n=1,71				! lats
	      DO I=0,28			! 27 prec days
       DO K=0,72				! lons
	      DA(I,K,n)=0.
	 enddo
	      ENDDO
	ENDDO
C
 	do k=0,72
	ires(k)=0
	smed(k)=0.
	enddo
C
C  Avoid input of prec. month:
C
      ncnt=0        ! count of days 1,2,...,15   
      if (idy.gt.15) goto 230	  ! goto input of current month
C  1st input of preceding mon-data

C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	nndy=im(jmn_pre)	  ! prec. mn
C	nnd1=nndy-5
	nnd1=nndy-14		  !-15d
	if (idys.ge.1) nnd1=nnd1+idys-1
C
C  day-to-day input for prec mon
C
	DO 400 jdy_pre=nnd1,nndy  ! =15 days for fixed UT
	call blet2(jdy_pre,PDY)

	CALL subreadmmu2c(qs,pyr,pmn,pdy,aut,amm,xx)
C
C DA(0:28,0:72,71)
c.		! TEC at glon=-180,-175,...,180
	 	DO ilat=1,71	  ! < LAT-BY-LAT
	   do k=0,72		 !<<<<<<<<<<<<<<<<<<
	da(28,k,ilat)=xx(ilat,k) ! TEC 
	enddo
C
	ENDDO				  !< LAT-BY-LAT
C Move data day-by-day up so that last day of month nndy=>day_27:
C
 	do ilat=1,71		  ! < LAT-BY-LAT
	do j=1,28			  ! <day-by-day
	do k=0,72			  ! all longi
	da(j-1,k,ilat)=da(j,k,ilat) ! move data one day up  
	enddo				  ! all longi
	enddo				  ! all days
	enddo				   ! all lati
	ncnt=ncnt+1
  400	CONTINUE		  !<day-by-day
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C start cycle on day-to-day for current mon  ======================================
C
  230	continue
	nndy=im(imn)	 ! end of current month

  490 format(1X,' year=',I2,' month=',I2,' day=',I2,' ut=',I2)
C
  499	CONTINUE
  	   DO 500 jjdy=1,idy2
	call blet2(jjdy,CDY)
C 
	CALL subreadmmu2c(qs,ayr,amn,cdy,aut,amm,xx)
C DA(0:28,0:72,71)
	 	DO ilat=1,71	  ! < LAT-BY-LAT
	   do k=0,72		 !<<<<<<<<<<<<<<<<<<
	da(28,k,ilat)=xx(ilat,k) ! TEC 
	enddo
C
	ENDDO				  !< LAT-BY-LAT
C++
  700 format(A128)
C++
C
C   reading map for current month
C
cr	glat=-90.
 704 	 continue
C
C Move data one day up: (1)	if(idy.lt.idy1)  (2) a
C
 	do ilat=1,71		  ! < LAT-BY-LAT
 	do j=1,28			  ! <day-by-day
	do k=0,72			  ! all longi
	da(j-1,k,ilat)=da(j,k,ilat) ! move data one day up 
	enddo				  ! all longi
	enddo				  !<day-by-day
      enddo                 ! all lati 
	ncnt=ncnt+1
		if ((ncnt.lt.15).or.(jjdy.lt.idy2)) goto 500
C
C Calculations for  day=idy: da(28,long,lat)
C	
  240	CONTINUE
	OPEN(112,FILE=OUTFILE)
C  VERIFICATION OF MEDIAN	FOR TEC_MAP(long,lat) for one day (28)
  115 CONTINUE
c
      DO 150 ilat=1,71			  ! Cycle on lati
C
C Median calculation:
C
	DO ilon=0,72	
C Prepare common array for -7 prec days, CC(7,0:72), for median calculation:
C     C DA(0:28,0:72,71) ! TEC -15 prec_days+curr_day=15,longs=73,lats=71

	DO kk=13,27
	kmed=kk-12
	CC(kmed,ilon)=da(kk,ilon,ilat)
	ENDDO	   ! cycle kk

	ENDDO      !cycle ilon
	ndays=15
	nlons=73
	CALL smed15mm1(CC,SMED)
	do k=0,72
	ires(k)=nint(smed(k)*10.)  !?
	enddo
c- 	WRITE(*,498) (IRES(K),K=0,72)		!Temp
 	WRITE(112,498) (IRES(K),K=0,72)  !med(TEC)
 150	continue         ! cycle ilat
C
C END OF MEDIAN_TECxhi_MAP FOR DAY idy(28)
C ------------------------------------------------------
C?? 498  FORMAT(360(1X,I4))
 498  FORMAT(73(1X,I4))
	CLOSE(unit=112)
CD	CLOSE(unit=113)
C
 202  CONTINUE
C-	 ncnt=14
C	  						  !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
C
C =========================================
  500 continue   ! end day-by-day cycle     !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
c-        call blet2(iut,AUT)
C-  	call subratmapfh(qs,AYR,AMN,ADY,AUT,AMM)

  301 CONTINUE		! end MIN cycle
	 
C	idy=indy
  300 CONTINUE		! end UT cycle
      write(*,*) outfile
c	pause ' ' 
       RETURN
C      STOP
	END