      program igstecnoond
C..............................................................Feb. 2017
C Produce TEC-noon-daily mean from IONEX GIM-TEC for IGS stations list
C CC(31) = daily noon TEC for station - not required
C ires(12) monthly median noon TEC*10
C	sites(288)
	character*76 infigs,outfile,txt
	dimension glat(288),glon(288),im(12)
C-	+,CC(31),ires(12)
	+,resd(288) ! daily noon for all IGS stations
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	CHARACTER*2 AYR,ADY,AMN,AUT
	CHARACTER*4 STAT,STATS(288),AYEAR,SOUT,TIME
	DATA  IM/31,28,31,30,31,30,31,31,30,31,30,31/
C
c
	      CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
      TT(5:)='      '
	TIME=tt(1:4)
C
      WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TT
C
	infigs='IGS-sites2.txt'
	OPEN(10,file=infigs,action='READ')
	icnt=0
   30	format(A76)						   !+
   31	format(A4,60X,F6.2,1X,F7.2)		   !+
   34	format(1X,A4,12(1X,I4))			   !+

   	read(10,30) txt ! title 
C//	write(11,30) txt
	DO i=1,288
	read(10,31,end=40) stats(i),glat(i),glon(i)
	icnt=icnt+1
	ENDDO
   40	close(unit=10)
C
   15	FORMAT(A4)
	outfile='tecnoond.txt'  ! Tamara
	OPEN(11,file=outfile,access='APPEND')
C
  201	      WRITE(*,*)' ENTER year  <00-1> = stop:'
		READ(*,15) AYEAR
      AYR=AYEAR(3:4)
	if (AYR.eq.'-1') goto 33  ! STOP
   	read(ayr,*) yr
	iyr=int(yr)
	if(int(yr/4.)*4.eq.iyr) THEN 
	im(2)=29
	ndnr=366
	                          ELSE
	IM(2)=28
	ndnr=365
	ENDIF
C
C
C
	nrd=im(imn)
C
C+++++++++++++++++Cycle on month to month +++++++++++++++++
C Temp MN-to-MN cycle
	imn0=1
	imn1=12
	if (iyr.eq.98) imn0=9
	if (iyr.eq.17) imn1=5 ! Temp for 2017
	DO 45 imn=imn0,imn1
C-	ires(imn)=0
	call blet2(imn,AMN)
	nrd=im(imn)
C Temp DAY-to-day cycle
	DO 44 idy=1,nrd
C-	CC(idy)=0.
	call blet2(idy,ADY)
C  ============ Cycle on IGS sites ==================
	do k=1,288
	resd(k)=0.
	enddo
C
	DO 41 kk=1,icnt  ! Cycle on IGS sites
	stat=stats(kk)
	glatk=glat(kk)
	glonk=glon(kk)
     	call blet0(stat,sout)
Crem	LT=UT+glonk/15.
      iutnoon=nint(12.0-glonk/15.0)
	if (iutnoon.lt.0) iutnoon=iutnoon+24
	if (iutnoon.ge.24) iutnoon=iutnoon-24
	call blet2(iutnoon,AUT)
C
C
	call subinterp2t(glatk,glonk,ayr,amn,ady,aut,res)
C-	cc(idy)=res
	resd(kk)=res/10.     ! noon TECU for given IGS site
   41	CONTINUE
C
      sum=0.
	do k=1,288
	sum=sum+resd(k)
	enddo
	 averd=sum/288.
		write(*,32) AYR,AMN,ADY,averd
		write(11,32) AYR,AMN,ADY,averd 
   44	CONTINUE
C-	call rmednoon(nrd,cc,rmed)
C-	ires(imn)=nint(rmed)
   45	CONTINUE
c-	write(*,34) sout,(ires(k),k=1,12)
c-	write(11,34) sout,(ires(k),k=1,12)
C-   41	CONTINUE
   32 FORMAT(1X,3A2,1X,F5.1)
	GOTO 201
   33      close(unit=11)
   	pause ' '
	STOP 
	END