C........................................................Aug. 2021
C extract taMNDDUT.jYR, tbMNDDUT.jYR files from daily IONEX files .txa .txb
C
C........................................................Nov.2012
C Decode JPLR hourly files
C input <jplrDDD0.iYR> IONEX1 files:
C from glats [90:-2:-90], glongs [-10:2:178] to produce normal IONEX file
C  jhrg  
C         lati:  87.5, 85.0,...,0,...,-87.5 ==> i=1,2,...71
C         longi:-180.0, -175.0,... 0...180.0 ==> j=0,...,72
C output <jhrgDDD0.iYR>
C 
      PROGRAM decodjplab
C----------------------------------------------------------------
C Select NEW+++:output 71 geographic latitudes: res1=87.5,85,,.0..-87.5N 
C at: NEW+++: 0,1,...,72 geographic longitudes [-180,-175,...,180] = IONEX step
C Produce results for 0, 1,..., 23hr UT.iyr  
C send results to d:/web/graf/teci/jhrgDDD0.iYR
C
C program for EXTRACTING FROM "JPRGdoy0.iYR" ionex1_TEC data 
C +++++++++
C
C*********TEST
      dimension glats(71),glons(0:72),itec_cur(71,0:72)
      integer itec(71,0:72)
	CHARACTER*1 ab
	CHARACTER*2 AYR,AMN,ADY,AUT
	+,rmn,rdy

C**********TEST
      CHARACTER*128 INFILE,OUTFILE
	CHARACTER*24 btxt
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	CHARACTER*4 AYEAR,RYEAR,NAME
	CHARACTER*80 txt
	CHARACTER*20 txt1,start,enddesc,epoch,tlats
	character*3 aday
	dimension txx(0:72),im(12)

	DATA  IM/31,28,31,30,31,30,31,31,30,31,30,31/
C++
C++
      ICALLS=0
	 write(*,*) ' Enter <a> or <b>:'
	read(*,*) ab
	epoch='EPOCH OF CURRENT MAP'
	tlats='LAT/LON1/LON2/DLON/H'
	btxt='-180.0 180.0   5.0 450.0'
	CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
      TT(5:)='      '
      WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TT
C Ljuba = replace following comands by current year
       iutend=24 !+++++++++++++++++++++++++
	AYEAR=DD(1:4)                  !Tamara               
	write(*,*) AYEAR
		ayr=ayear(3:4)
	read(ayr,*) ryr
	iyr=int(ryr)
	read(ayear,*) xyear
	IYYYY=int(xyear)
	read(ayr,*) ryr
	iyr=int(ryr)
C Ljuba = replace following comands by current month
		WRITE(*,*) 'Enter AMN for input: '  !Tamara
	 	read(*,*) AMN					   !Tamara
C	AMN=DD(5:6)               !Tamara
	write(*,*) amn

	read(amn,*) xmn
	imn=int(xmn)
C
		idayy=365
	      IM(2)=28
        if(iyr/4*4.eq.iyr) then
	  idayy=366
	   	 IM(2)=29
	  endif

C Ljuba = replace 2 following comands by last available data-DAY
		WRITE(*,*) 'Enter dy for input: '  !Tamara
	 	read(*,*) idy					   !Tamara
  255	call blet2(idy,ady)
C	
  987	format(I2)
	call blet2(idy,ADY)
C
	lda=ndoy(iyr,imn,idy)
	lda_pre=lda-1
	iyr_pre=iyr
	call submmdd(lda_pre,iyr_pre,imn_pre,idy_pre)
	if (lda_pre.le.0) then
	iyr_pre=iyr-1
	imn_pre=12
	idy_pre=31
	lda_pre=ndoy(iyr_pre,imn_pre,idy_pre)
	endif
  178	call blet3(lda,ADAY)
C
C
 1001 CONTINUE
C
	glat=90.
	DO i=1,71
	glat=glat-2.5
	glats(i)=glat
	ENDDO
C
	glon=-185.
	do i=0,72
	glon=glon+5.0
	glons(i)=glon
	enddo
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

C
	IRUN=0 ! 
	iut0=0 ! 
	ady0=float(idy_pre)
CEND TEMP
	enddesc='END OF HEADER       '
C	start='START OF TEC MAP    '
	start='START OF W-index MAP'
	name='jplr' !
C--	infile='d:\utec\2012\jplrDDD0.YRi'
C-		infile='d:\web\graf\TECI\JPLRDDD0.YRi'	!Tamara
		infile='d:\web\graf\dwc\YR\MN\YRMNDYw.txx'	
c-	infile(22:24)=ADAY					 !Tamara
	infile(17:18)=ayr					 !Tamara
      infile(33:33)=ab					 !Tamara
	infile(20:21)=amn					 !Tamara
	infile(23:24)=ayr					 !Tamara
	infile(25:26)=amn					 !Tamara
	infile(27:28)=ady					 !Tamara
	OPEN(11,FILE=INFILE,ACTION='READ') ! w-index input in IONEX
C
      outfile='d:\web\graf\dwc\YR\MN\ut\waMNDDUT.jYR'	 !Tamara
	outfile(17:18)=AYR						 !Tamara
	outfile(36:37)=AYR						 !Tamara
		 outfile(20:21)=AMN					 !Tamara
	outfile(27:27)=ab					 !Tamara
	outfile(28:29)=AMN					 !Tamara 
      outfile(30:31)=ADY						 !Tamara
  118	format(A4)
cc	pause  ' '
C
C =========================================
	do k=0,72
	txx(k)=0.	! output tec for -180, -175,...00,05,...,180 deg.E
	do i=1,71
	itec(i,k)=0	! output TEC lat x long array 
	enddo
	enddo
c
  198 format(1X,A39,1X,A39)
	write(*,*) 'Check name of infile: ',infile
c//	pause ' '
c
	write(*,199) ayr,amn,ady
  199	format(3(1X,A2))
   27 format(A80)
C++
	ist=0
	JOUT=0
	JSTR=0
	JUC=0
	JMAG=0
CC
  800 continue !
c ***************************************************************
C start cycle on hr-to-hr input:
   80	do i=1,100					             !!
   79	READ (11,187,END=33,ERR=2) txt,txt1  ! 
  187	format(A60,A20)
	if (txt1.eq.start) then
	 write(*,187) txt,txt1
c-	write(12,187) txt,txt1
      goto 88
	                  else
	goto 79
	endif
	enddo									 !!
  88	continue
C
C Start of reading VTEC ========================
   89 format(2X,A4,4X,A2,4X,A2,2(4X,I2))
   86 format(2X,A4,4X,A2,4X,A2,4X,A2)
        DO 775 iut=0,23
	call blet2(iut,AUT)
	outfile(32:33)=AUT						 !Tamara

	OPEN(12,FILE=OUTFILE) !TEC results in IONEX
CC

   	read (11,89,end=9,err=85) ryear,rmn,rdy,iut,imin
	 write(*,86) ryear,rmn,rdy,aut
c-	write(12,86) ryear,rmn,rdy,iut,epoch
C
C lati cycle:
C
C Start of reading WTEC ========================for lats=87.5:-2.5:-87.5
	call subtread1(11,itec_cur) 

CADD++++++++++++++++++++++++++++++++++++++++++++++++
C output line of W-index for 
   85	continue
  181 format(2X,I2,2X,F5.1)
C
C ==================================================
C OUTPUT OF RESULTS
C?	DO nnlat=1,71		!Output for glats=87.5,85,..., -87.5
        glat=-90.
	DO nnlat=1,71		!Output for glats=-87.5,-85,..., 87.5
	n1=72-nnlat
	glat=glat+2.5
c//	write(*,182) (tec_cur(nnlat,k),k=0,72)
	write(12,182) (itec_cur(n1,k),k=0,72)
	ENDDO
 182	format(73(1X,I4))							
  280 format(2X,F6.1,A24,28X,A20)
  281	format(16(1X,I4))
  282	format(9(1X,I4))	 
        read(11,*,end=9) txt ! extra line
  775 continue   ! End calculation for given UT
C
    9	continue
C Continue to the next UT hr :
  32		irun=irun+1 
c	if (irun.le.iutend) goto 80 ! continue to the next UT hr =>>>>
c      if (iut.lt.22) goto 80 ! continue to the next UT hr =>>>>
C	pause ' '
C++++++++++++++++++++++++++++
C Output of GEC results
C

C 
  101 continue
	irun=0
c-	close(unit=111)
		goto 33	   ! end of calculations
C
c	write (*,888) alat,alon,aday
c  888	format(1X,' alat=',A3,' alon=',A3,' day=',A3)

    2 CONTINUE
      if (irun.eq.0) then
       write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
 	pause ' '
	goto 35
      endif

   33 CONTINUE
   35      write(*,*) infile,outfile
	write(*,*) irun
C temp
	close(unit=12)
c-	idy=idy+1
crem	if (idy.le.im(imn)) then
crem	goto 255
crem	endif
      pause ' ' 
      STOP
       END

C***********************************************************
C ===========================================================
	subroutine SUBTREAD1(nn,iyy)
C............................................................Mar 2014
C Reading IONEX to map line
C nn= UNIT number of read COMMAND
C....................                                        ! Nov. 2012   
C
C   EXTRACT TEC FROM IONEX1 format to array yy(glat,glon) relevant to IONEX format
c
C
C
c
      DIMENSION itxx(0:72),iyy(71,0:72),ixxx(16)
	character*60 txt

  90	format(3X,F5.1,A60)
180	format(16(1X,I4))
179	format(9(1X,I4))

	alat=90.	! resuts alat
c-	glat1=92.
C	trem=20.
	DO 20 ii=1,71 ! cycly on output lats
	alat=alat-2.5
	do k=0,72
	itxx(k)=0
	enddo
   10	read(nn,90,err=2,end=9) glat,txt
c-	glat2=glat
C
	do j=1,4
	j1=(j-1)*16
    1	READ (nn,180,END=9,ERR=2) (ixxx(i),i=1,16)
	do k=1,16
c-	if ((ixxx(k).le.0).or.(ixxx(k).gt.9990)) then
c-	ixxx(k)=itrem ! replace wrong TEC
c-	                                       endif
	itxx(j1+k-1)=ixxx(k)
c-	trem=xxx(k)
	enddo
	enddo
	READ (nn,179,END=9,ERR=2) (ixxx(i),i=1,9)
		do k=1,9
c-	if ((xxx(k).le.0.).or.(xxx(k).gt.9990.)) then
c-	xxx(k)=trem ! replace wrong TEC
c-	                                       endif
	itxx(63+k)=ixxx(k)
c-	trem=xxx(k)
	enddo
	do jlon=0,72
	iyy(ii,jlon)=itxx(jlon)
	enddo
   20	continue
C
	goto 22
C ============================================	
    9	write(*,*) ' end of file'
	pause ' '
	goto 22
    2	write(*,*) ' error in input file'
 	pause ' '
C
   22 continue
	return
	end
C
C ===============================================================
C ===============================================================
