program igstecw1
C..............................................................Dec. 2016
C Produce TEC from IONEX GIM-TEC for IGS stations list
C produce W(TEC) index for IGS stations using -7day median
C
C	sites(288)
	character*76 infigs,outfile,txt
	dimension glat(288),glon(288),im(12),ixxx(0:23)
	CHARACTER*60 list(288),listk
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	CHARACTER*56 txt3,txt4,txt6
	CHARACTER*16 txt2,txt5
	CHARACTER*7 txt1
	CHARACTER*1 ac
	CHARACTER*2 AYR,AMN,ADY,ADD,AUT,AMM,DY1,DY2
	CHARACTER*4 STAT,STATS(288),AYEAR,SOUT,TIME
	DATA  IM/31,28,31,30,31,30,31,31,30,31,30,31/
	COMMON /BL2/LISTK,AYEAR,AMN,DY1,DY2,GLATK,GLONK
C
      ac='c' ! for all pre_days // ac='a' for current day
	txt1='TECU*10'
      txt2='Date of issue:  '
      txt3='YYMMDD|UT 0    1    2    3    4    5    6    7    8    9'
	txt4='   10   11   12   13   14   15   16   17   18   19   20 '
	txt5='  21   22   23  '  
      txt6='--------------------------------------------------------'
c
	      CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
	AYEAR=DD(1:4)
	AYR=AYEAR(3:4)
	AMM=DD(5:6)
C++      AMM='01' ! TEMP
	ADD=DD(7:8)
C++      ADD='31' !TEMP
      TT(5:)='      '
	TIME=tt(1:4)
	read(ADD,*) rdy
	nrd=int(rdy)      ! current day
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,A60,F6.2,1X,F7.2)
   32	format(A4,A60,1X,A7,2X,'glat ='F6.2,1X,'glon ='F7.2)        ! txt1=TECU
   33	format(2A56,A16,1X)
   34	format(3A2,1X,24(I4,1X))
   35	format(A16,A4,2A2,1X,'Time = ',A4,1X)

   	read(10,30) txt ! title 
C//	write(11,30) txt
	DO i=1,288
	read(10,31,end=40) stats(i),list(i),glat(i),glon(i)
	icnt=icnt+1
	ENDDO
   40	close(unit=10)
C
   15	FORMAT(A2)
C
      AMN=AMM
	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
	read(amn,*) xmn
	imn=int(xmn)
	ndmn=im(imn)
	outfile='d:\web\graf\dat0\YR\statYRMNt.txt'  ! Tamara
	outfile(18:19)=AYR							 ! Tamara
	outfile(25:26)=AYR							 ! Tamara
	outfile(27:28)=AMN							 ! Tamara
C
C  ============ Cycle on IGS sites ==================
C
	DO 41 ist=1,icnt  ! Cycle on IGS sites
	stat=stats(ist)
	glatk=glat(ist)
	glonk=glon(ist)
      listk=list(ist)
	call blet0(stat,sout)
	outfile(21:24)=sout							 ! Tamara
	OPEN(11,file=outfile)
C
C Temp DAY-to-day cycle

	DY1='01'  ! start of month
	DY2=ADD   ! current day (end day for calculation)
C
	IF (AMM.ne.AMN) then 
	idy2=im(imn)
	call blet2(idy2,DY2)
	nrd=idy2
	ENDIF
C
	DO 44 idy=1,nrd
	call blet2(idy,ADY)
	if ((ADY.eq.ADD).and.(AMN.eq.AMM)) then
	ac='a'	  !norm
C++	ac='c'  ! temp - end-of-month
	else
	ac='c'
      endif
C
	if (idy.eq.1) then
	write(*,32) stat,listk,txt1,glatk,glonk
	write(11,32) stat,listk,txt1,glatk,glonk
C	write(*,35) txt2,AYEAR,AMM,ADD,TIME
	write(11,35) txt2,AYEAR,AMM,ADD,TIME
C	write(*,33) txt3,txt4,txt5
	write(11,33) txt3,txt4,txt5
C	write(*,33) txt6,txt6,txt6
	write(11,33) txt6,txt6,txt6
	endif
C
	DO iut=0,23
	call blet2(iut,AUT)
	call subinterp1t(ac,glatk,glonk,ayr,amn,ady,aut,res)
	 ixxx(iut)=nint(res)
	ENDDO
C	write(*,34) AYR,AMN,ADY,(ixxx(k),k=0,23)
	write(11,34) AYR,AMN,ADY,(ixxx(k),k=0,23)
   44	CONTINUE
      close(unit=11)
C
C W(TEC) calculation
C
      call subdevtec1(stat)    ! DEVLOG, WTEC
C
   41	CONTINUE
	
	pause ' '
	STOP 
	END