C T.L.Gulyaeva...........................................Aug. 2013
C
C Scale 1h UT file of IONEX format to uhrg data file
C
C outfile: IONEX 'd:\web\graf\TECI\YYMMDDt.txt' file
C
C Include input of IONEX_1h file <ehrgXXX0.12i>+anygXXX0.12i file
C                                              +anygYYY0.12i file  
C 
C
C +++++++++++++++++++++++++++++++++++
C
C
C T.L.Gulyaeva...........................................Jan 2010
C 
      PROGRAM MAPSCAL2
C----------------------------------------------------------------
C Extract TEC at given glat x glon table <statusf.txt>
C
C glat= 87.5, 85,...,-85, -87,5 = 71 lines => 71 sets of 12 files for 2h UT bins
C glon= -180,-175,..., +175, 180  = 0,...,72 columns
C
C-------------------------------------------------------------------
C program for EXTRACTING FROM "JPLGdoy0.iYR" ionex_TEC data 
C
C*********TEST
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
      CHARACTER*3 XXX,YYY
	CHARACTER*80 INFILE1,INFILE2,INFILE3,OUTFILE,TLATLON
	CHARACTER*4 AYEAR,BYEAR,CYEAR,CTIME,NAME
	CHARACTER*60 txt
	CHARACTER*16 txt1,start
	character*2 ayr,amn,dy1,dy2,aut,CMN,CDY
	+,BMN,BDY
		integer*2 iyr,imn,idy1,idy2,iut,jut,nfile
	dimension im(12)
c//     +,tecp1(71,0:72),tecp2(71,0:72),tecp3(71,0:72)  ! 
      INTEGER itec1(0:72),itec2(0:72),itec3(0:72)
	dimension ires(0:72) 
	     COMMON  /CONST/UMR
	DATA  IM/31,28,31,30,31,30,31,31,30,31,30,31/

C
	IRUN=0
		start='START OF TEC MAP'
	CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
      TT(5:)='      '
	cyear=DD(1:4)
  	 cmn=DD(5:6)
	cdy=DD(7:8)			 
	ctime=TT

      WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TT
C

	WRITE(*,*) 'Enter <jplg> or <ehrg> for scaling input: '
	read(*,118) name
	WRITE(*,*) 'Enter input YEAR : '
	read(*,118) AYEAR
	ayr=AYEAR(3:4)
	read(ayr,*) ryr
	iyr=int(ryr)
C
	WRITE(*,*) 'Enter input MN : '
	read(*,116) AMN
	read(amn,*) rmn
	imn=int(rmn)
C
      WRITE(*,'(\A\)') ' ENTER <DAY1>,<DAY2> OF INPUT FILE='
      READ(*,'(A)') DY1,DY2
CC CALCULATION OF DAY OF YEAR	(LDA)
	if(int(ryr/4.)*4.eq.iyr) THEN 
	im(2)=29
	                          ELSE
	IM(2)=28
	ENDIF


c//      READ(*,116) DY1,DY2
	read(dy1,*) xdy
	idy1=int(xdy)
	read(dy2,*) xdy2
	idy2=int(xdy2)
C
	lda1=ndoy(iyr,imn,idy1)
	lda2=ndoy(iyr,imn,idy2)
	call blet3(lda1,XXX)
	call blet3(lda2,YYY)


C
	infile2='d:\web\graf\teci\YYMMDDt.txt'
	infile2(18:19)=ayr
	infile2(20:21)=amn
	infile2(22:23)=dy1
C    infile1 & infile2 for day XXX
	infile1='d:\utec\2013\ehrgXXX0.13i'
	infile1(14:17)=name
	infile1(18:20)=XXX
	infile1(23:24)=ayr
C infile 3 and outfile for day YYY
	infile3=infile1   
	infile3(18:20)=YYY  
C ADD
c outfile =================================
C
crem	outfile='d:\web\graf\teci\upcgYYY0.12i'
	outfile=infile2
	outfile(22:23)=dy2
		OPEN(11,FILE=INFILE1)
		OPEN(12,FILE=INFILE2)
		OPEN(13,FILE=INFILE3)

c		OPEN(14,FILE=OUTFILE,access='APPEND')
		OPEN(14,FILE=OUTFILE)

C fix hour step:
	if (name(2:2).eq.'h') then
	idelh=1
	iruns=25
	       else
	idelh=2
	iruns=13
	endif
C end fix

  116	format(A2)
  118	format(A4)
c	pause  ' '
   80	do i=1,1000					             !!
	READ (11,187,END=88,ERR=2) txt,txt1
	if (txt1.eq.start) then 
	write(*,187) txt,txt1
	goto 88
	endif
	enddo									 !!
  88	continue
  280	do i=1,1000					             !!
	READ (12,187,END=288,ERR=2) txt,txt1
	if (i.lt.30) then
	if (i.eq.2) txt(41:42)=dy2
	if (i.eq.13) txt(17:18)=dy2
	if (i.eq.14) txt(17:18)=dy2
	write(*,187) txt,txt1
	write(14,187) txt,txt1
	endif
	if (txt1.eq.start) then 
	write(*,187) txt,txt1
	write(14,187) txt,txt1
	goto 288
	endif
	enddo									 !!
  288	continue
  380	do i=1,1000					             !!
	READ (13,187,END=388,ERR=2) txt,txt1
	if (txt1.eq.start) then
	write(*,187) txt,txt1
	goto 388
	endif
	enddo									 !!
  388	continue

C =========================================
C Cycle on UT;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	do 488 iut=0,24,idelh
	call blet2(iut,AUT)
c
C
C Start input for given UT:++++++++++++++++++++
C
175	CONTINUE
C
  176 format(A128)
  107	FORMAT(1X,A13,A2,3X,2(F5.1,1X),27X,I1,34X,2(F6.1))		   
C =========================================
C  
  700	 continue
		iflag=0
C
c//	ih0=-1
C  Start of UT selection for given day:
C
  187	format(A60,A16)
c ***************************************************************
D start cycle on hr-to-hr input:
	if (iut.lt.24) then
	iutc=iut
	else
	iutc=0
	endif
  150    read (11,89,end=85,err=85) byear,bmn,bdy,jut
	if (bmn(1:1).eq.' ') bmn(1:1)='0'
	if (bdy(1:1).eq.' ') bdy(1:1)='0'
      if ((byear.eq.ayear).and.(bmn.eq.amn).and.(bdy.eq.dy1)
	+.and.(jut.eq.iutc)) then
	goto 85
	            else
	goto 150
	endif
   85	continue
c      write(*,*) txt1
c	pause ' '

   89 format(2X,A4,4X,A2,4X,A2,4X,I2)
  189 format(2X,A4,4X,A2,4X,A2,4X,I2,36X,'EPOCH OF CURRENT MAP')
C Start of reading VTEC ========================

  250	read (12,89,end=285,err=285) byear,bmn,bdy,jut
      if (bmn(1:1).eq.' ') bmn(1:1)='0'
	if (bdy(1:1).eq.' ') bdy(1:1)='0'

	if ((byear.eq.ayear).and.(bmn.eq.amn).and.(bdy.eq.dy1)
	+.and.(jut.eq.iutc)) then
 	write(*,89) byear,bmn,bdy,jut
 	write(14,189) byear,bmn,bdy,jut
	goto 285
	            else
	goto 250
	endif
  285	continue
  350	read (13,89,end=385,err=385) byear,bmn,bdy,jut
	if (bmn(1:1).eq.' ') bmn(1:1)='0'
	if (bdy(1:1).eq.' ') bdy(1:1)='0'
      if ((byear.eq.ayear).and.(bmn.eq.amn).and.(bdy.eq.dy2)
	+.and.(jut.eq.iutc)) then
	goto 385
	            else
	goto 350
	endif
  385	continue
c      write(*,89) ryear,rmn,rdy,iut
C Start cycle on latitute
	DO 487 ilat=1,71

c	nrday=int(daynr)
	do k=0,72
	ires(k)=0.
	itec1(k)=0
	itec2(k)=0
	itec2(k)=0
	enddo
C

	 nfile=11
	 call subread1(nfile,TLATLON,itec1)
	 nfile=12
	 call subread1(nfile,TLATLON,itec2)
	 nfile=13
	 call subread1(nfile,TLATLON,itec3)
C Scaling results
	DO k=0,72
	if (itec1(k).gt.0) then
	aa=float(itec1(k))
	bb=float(itec2(k))
	rat=bb/aa
	endif
	ires(k)=nint(itec3(k)*rat)
	enddo
C +++++++++++ 
  390 format(A80)
  391 format(16(1X,I4))
  392 format(9(1X,I4))
C Output of scaled line:
	write(*,390) TLATLON
	write(14,390) TLATLON
	do jj=1,4
	j1=(jj-1)*16
	j2=j1+15
	write(*,391) (ires(k),k=j1,j2)
	write(14,391) (ires(k),k=j1,j2)
	enddo
	j1=64
	j2=72
	write(*,392) (ires(k),k=j1,j2)
	write(14,392) (ires(k),k=j1,j2)
  487 CONTINUE ! end lat cycle
	READ (11,187,END=88,ERR=2) txt,txt1
	READ (11,187,END=88,ERR=2) txt,txt1
	READ (12,187,END=88,ERR=2) txt,txt1
	READ (13,187,END=88,ERR=2) txt,txt1
	READ (13,187,END=88,ERR=2) txt,txt1
	write(*,187) txt,txt1
	write(14,187) txt,txt1
	if (iut.eq.24-idelh) then
	dy1=dy2
	endif
C
  488	CONTINUE  ! end UT cycle
C
	close(unit=11)
	close(unit=12)
	close(unit=13)
	close(unit=14)
	goto 35
C 
    2 CONTINUE
	       write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
	    	pause ' '
 35      write(*,*) infile1,infile2,infile3,outfile
      pause ' ' 
      STOP
       END

C 
C==============================================================================
	SUBROUTINE SUBREAD1(nn,title,itxx)
	INTEGER itxx(0:72),ixx(16)
	character*80 title,txt
	integer*2 nn
  190 format(A80)
  191 format(16(1X,I4))
  192 format(9(1X,I4))

	read(nn,190,end=55,err=65) title
	goto 56
   55	write(*,*) ' end-of-file',nn
	pause ' '
	stop
   65	write(*,*) ' error reading txt in :',nn
	pause ' '
	stop
   56	read(nn,190) txt
	backspace(nn)
crem	DO 777 lat=1,71	   ! Start cycle on glati ++++++++++++++++++++++++++++++++
crem		ilat=ilat+1   ! ilat=1 for 87.5
crem	glati=glati-2.5
c   77	DO kl=1,72                 ! cycle on latitudes
c//   87	read (111,90,end=9,err=2) glat,txt
   90	format(3X,F5.1,A60)
  91   	j1=0
C
C Add check of wrong TEC.le.0<=itec_pre +++++++++++++
C
	itec_pre=20	  ! assumed TEC_pre 
	do j=1,4        
	j1=(j-1)*16
   1	READ (nn,180,END=9,ERR=2) (ixx(i),i=1,16)
  180	format(16(1X,I4))
	do k=1,16
	if (ixx(k).le.9) ixx(k)=itec_pre  ! replace wrong TEC
	itxx(j1+k-1)=ixx(k)
	itec_pre=ixx(k)		! latest TEC_pre
	enddo
	enddo			  ! start selection of 4 longitudes
	READ (nn,179,END=9,ERR=2) (ixx(i),i=1,9)
  179	format(9(1X,I4))
	do k=1,9
	if (ixx(k).le.9) ixx(k)=itec_pre  ! replace wrong TEC
	itxx(64+k-1)=ixx(k)
	itec_pre=ixx(k)		! latest TEC_pre
	enddo
	goto 9
    2 CONTINUE
	       write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
	    	pause ' '
	goto 9

    9	RETURN
	END
	 
C
C***********************************************************
