C........................................................Nov.2016
C Decode .iwg hourly files
C input : d:\YEAR\stYEAR.txt 
C  => output file d:\YEAR\stYRf.txt
C 
      PROGRAM decodiwg
C
C*********TEST
      dimension ihrs(744),iff2(744)
      integer ires(0:23),inf(31)
	CHARACTER*2 AYR,ST,AA(0:23),AFF2(744)
      CHARACTER*80 INFILE,OUTFILE,title,txt
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	CHARACTER*4 AYEAR,PARAM,TIT1,TIT2
	CHARACTER*120 rmed,rcnt
	dimension im(12)

	DATA  IM/31,28,31,30,31,30,31,31,30,31,30,31/
C++
C++
      ICALLS=0
	PARAM='foF2'
	CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
      TT(5:)='      '
      WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TT
C
	write(*,*) ' Enter ST: '
	read(*,26) ST

C cycle on year
C	AYEAR=DD(1:4)                  !Tamara               
	write(*,*) ' Enter YEAR: '
	read(*,118) AYEAR
	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
		idayy=365
	      IM(2)=28
        if(iyr/4*4.eq.iyr) then
	  idayy=366
	   	 IM(2)=29
	  endif

C	
  26	format(A2)
   27 format(A80)
  118	format(A4)
  189	format(24(I3,2X))
  190	format(A120)
  191	format(24(I5))
  192	format(24(I3,A2))
  193	format(20(I2,4X))
  194	format(A80,1X,A4,3(1X,I4))
  195	format(3(I4))
  196	format(4(I4))
  197	format(5(I4))
  198	format(6(I4))
  199	format(30(I4))
C
C
C
 1001 CONTINUE
C
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
	IRUN=0 ! 
CEND TEMP
C--	infile='d:\utec\2012\jplrDDD0.YRi'
		infile='d:\YEAR\stYEAR.txt'	!Tamara
	infile(4:7)=AYEAR					 !Tamara
	infile(9:10)=ST					 !Tamara
	infile(11:14)=ayear					 !Tamara
C
	outfile='d:\YEAR\stYRf.txt'
	outfile(4:7)=AYEAR						 !Tamara
		 outfile(9:10)=ST					 !Tamara
		 outfile(11:12)=AYR					 !Tamara
cc	pause  ' '
C
c
c
	OPEN(10,FILE=INFILE,ACTION='READ') ! 
	OPEN(11,FILE=OUTFILE) ! 
CC
      do k=1,31
	inf(k)=0
	enddo
CC
C  +++++++++++++++++++++++++++++
	read (10,27,err=33,end=702) title !read title line
      TIT1=title(1:4)        !+++++++++++++++++++++++++++++++
C
C Read iyear,imn,idmn,idy1,itoth,inf
  701	read (10,199,err=33,end=702) iyear,imn,idmn,idy1,itoth
	+,(inf(k),k=1,25) !
C
      write(*,194) title,param,iyear,imn,idmn
	write(11,194) title,param,iyear,imn,idmn   
C
	irest=idmn-25
	if (irest.eq.3) then
	 read (10,195,err=33,end=702) (inf(k),k=26,28)
	 endif 
	if (irest.eq.4) then
	 read (10,196,err=33,end=702) (inf(k),k=26,29)
	 endif 
	if (irest.eq.5) then
	 read (10,197,err=33,end=702) (inf(k),k=26,30)
	 endif 
	if (irest.eq.6) then
	 read (10,198,err=33,end=702) (inf(k),k=26,31)
	 endif 
C
      read(10,27) txt  !extra line
	read(10,27) txt  !extra line
	read(10,27) txt  !extra line
C
	cnts=itoth/20.
	 icnts=int(cnts)
	if ((icnts*20).lt.itoth) icnts=icnts+1
	DO kk=1,icnts
	k1=(kk-1)*20+1
	k2=k1+19
	read(10,193,err=33,end=702) (ihrs(k),k=k1,k2)
	ENDDO
	cntf=itoth/24.
	icntf=int(cntf)
	if ((icntf*24).lt.itoth) icntf=icntf+1
	DO kk=1,icntf
	k1=(kk-1)*24+1
	k2=k1+23
	read(10,192,err=33,end=702) (iff2(k),AFF2(k),k=k1,k2)
	ENDDO
      read(10,190,err=33,end=702) rmed
	read(10,190,err=33,end=702) rcnt
C
C Form output lines
C       
	k2=0
      DO 700 idy=1,31
	k1=k2+1
	k2=k2+inf(idy)
	do k=0,23
	ires(k)=0
	AA(k)='  '
	enddo
	if (inf(idy).eq.0) goto 699
	if (idy.gt.idmn) GOTO 699  ! => output line
C
      DO n=k1,k2
	nn=ihrs(n)
	ires(nn)=iff2(n)
	AA(nn)=aff2(n)
	ENDDO
C
  699 write(*,192) (ires(k),AA(k),k=0,23)
      write(11,192) (ires(k),AA(k),k=0,23)

  700	continue !      
	write(*,190) rmed
	write(11,190) rmed
	write(*,190) rcnt
	write(11,190) rcnt
C
  703 read(10,27,err=33,end=702) title !read title line
	TIT2=title(1:4) 
	if (TIT2.eq.TIT1) then
	GOTO 701
	          else
	GOTO 703
	            endif
C
  702 close(unit=10)
	close(unit=11)
	goto 33
C

    2 CONTINUE
       write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
	goto 35


   33 CONTINUE
   35      write(*,*) infile,outfile
      pause ' ' 
      STOP
       END

C***********************************************************
