C.......................................................Oct.2015
C
C.......................................................Apr. 2013
C Send combined files to /dfc/YR/MN/
C                        /dhc/YR/MN/
C                        /dtc/YR/MN/
C                        /dtw/YR/MN/
C
C Add parameter <n> =1 - foF2, 2 <hmF2>, 3 (TEC>, 4  <W-map>
C IONEX Format
C					                                  Nov. 2011
C       Combine monthly set of fiF2, hmF2, TEC and W-index maps (TEC) 
C       to combine daily set of maps for UT=00,01,...,23 h UT
      subroutine submapd4(num,iyr,imn,idy,iyr_nex,imn_nex,idy_nex)
C      output	YYMMDDw.txt
C
      DIMENSION im(12)
      character*2 ayr,amn,aut,amap,ayr_nex,amn_nex
	+,syr,smn,sdy
	character*3 aday
	character*1 fhw
	character*45 infile,outfile
	character*4 AYEAR
c//	character*125  txt
	character*80 txt1(71),txt2(71),txt3(71),txt4(71)
	character*45 txt5(71)
	character*60 title(8),zzz
	character*38 txxx
	character*22 tyyy,eoh
C++	integer*2 iyr,imn,idy,iut,imap
C++	+,iyr_nex,imn_nex,idy_nex,isdy,nnc,nnc1,nnc2 
	character*20 tool
	DATA  IM/31,28,31,30,31,30,31,31,30,31,30,31/
	DATA TITLE /
	+ 'W-INDEX IONOSPHERE MAPS                                     '
	+,'Global ionosphere maps for day 274, 2010 ( 1-10-2010)       '
     +,'produced from JPL GPS TEC IONEX MAP                         '
     +,'W values in index units, i.u. Hours, UT.                    '				                    
     +,'     1                                START OF W-index MAP  '
     +,'  2010    10    01    00    00    00  EPOCH OF CURRENT MAP  '
     +,'   87.5 -87.5  2.5                    LAT1/ LAT2/ DLAT	  '
     +,' -180.0 180.0  5.0                    LON1/ LON2/ DLON	  '/
cc-      COMMON /yymmdy/AYR,AMN,IDY1,IDY2
	eoh='END OF HEADER         '
C
	tool=' with IRI-PLas model'
		call blet2(iyr,ayr)
		call blet2(imn,amn)
	call blet2(iyr_nex,ayr_nex)
		call blet2(imn_nex,amn_nex)
C
C
C
	yr=float(iyr)
	if(int(yr/4.)*4.eq.iyr) THEN 
	im(2)=29
	                          ELSE
	IM(2)=28
	ENDIF
C++
c//	call submmdd(LDY1,iyr,imn1,idy1)
c//	call submmdd(LDY1,iyr,imn2,idy2)
C++
C
C 
C
c//	 num  - entered parameter
      infile='d:\web\dts\yy\mm\tcmmddut.jyr'		!Tamara
	outfile='d:\web\graf\dtc\yy\mn\yymmddt.txt'			!Tamara
C Cycle on 4 parameters
  25  continue

C
	if (num.eq.1) then
	fhw='f'
C      ! foF2						!Tamara
	infile(9:9)='f'									!Tamara
	infile(18:18)='f'									!Tamara

	outfile(14:15)='fc'									!Tamara
	outfile(29:29)='f'									!Tamara
	zzz=title(1)										!Tamara
	zzz(1:7)='  foF2 '
	title(1)=zzz
	zzz=title(3)
	zzz(36:55)=tool
	title(3)=zzz
	zzz=title(4)
	zzz(1:40)='foF2 values in 0.1 MHz. Hours, UT.      '
	title(4)=zzz
	 zzz=title(5)
	zzz(48:58)='foF2 MAP   '
	title(5)=zzz
	goto 55
	endif
	if (num.eq.2) then
	 fhw='h'
C	   ! hmF2				  !Tamara
	infile(9:9)='h'							  !Tamara
	infile(18:18)='h'							  !Tamara

	outfile(14:15)='hc'							  !Tamara
	outfile(29:29)='h'							  !Tamara
	zzz=title(1)
	zzz(1:7)='  hmF2 '
	title(1)=zzz
	zzz=title(3)
	zzz(36:55)=tool
	title(3)=zzz
	zzz=title(4)
	zzz(1:40)='hmF2 values in km. Hours, UT.           '
	title(4)=zzz
	 zzz=title(5)
	zzz(48:58)='hmF2 MAP   '
	title(5)=zzz
	goto 55  
	endif
	if (num.eq.3) then ! TEC
	fhw='t'
	infile(9:9)='t'							  !Tamara
	infile(18:18)='t'							  !Tamara

	outfile(14:15)='tc'							  !Tamara
	outfile(29:29)='t'							  !Tamara
	zzz=title(1)
	zzz(1:7)='  TEC  '
	title(1)=zzz
	zzz=title(3)
	zzz(36:55)='                    '
	title(3)=zzz
	zzz=title(4)
	zzz(1:40)='TEC values in TECU/10. Hours, UT.       '	
	title(4)=zzz
	 zzz=title(5)
	zzz(48:58)='TEC MAP    '
	title(5)=zzz
	goto 55  
	endif
	if (num.eq.4) then ! W-index
	fhw='w'
	infile(9:9)='w'	   						 !Tamara
	infile(18:18)='w'							 !Tamara

	outfile(14:15)='wc'							 !Tamara
	outfile(29:29)='w'							 !Tamara
	zzz=title(1)
	zzz(1:7)='W-INDEX'
	title(1)=zzz
	zzz=title(3)
	zzz(36:55)='                    '
	title(3)=zzz
	zzz=title(4)
	zzz(1:40)='W values in index units, i.u. Hours, UT.'	
	title(4)=zzz
	 zzz=title(5)
	zzz(48:58)='W-index MAP'
	title(5)=zzz
	goto 55  
	endif
C++
  55	CONTINUE
c	nnc1     !number of days in current month
c	nnc2	 !number of days in next month

C Cycle on days
   56	if ((ayr.eq.ayr_nex).and.(amn.eq.amn_nex)) then 
	nnc1=idy_nex-idy+1
	nnc2=0
	                      else
	nnc1=im(imn)-idy+1
	nnc2=idy_nex
	endif
      nnc=nnc1+nnc2
C
C Day-to-day cycle
	DO 201 ldy=1,nnc
	if (ldy.le.nnc1) then
	syr=ayr
	smn=amn
	isdy=idy+ldy-1
	 lday=ndoy(iyr,imn,isdy)
	else
	syr=ayr_nex
	 smn=amn_nex
	isdy=ldy-im(imn)+idy-1
	lday=ndoy(iyr_nex,imn_nex,isdy)
	endif
	call blet2(isdy,SDY)
	call blet3(lday,ADAY)

   57	AYEAR(3:4)=SYR
	read(syr,*) yr
	if (yr.gt.90.) then
	AYEAR(1:2)='19'
	           else
	AYEAR(1:2)='20'
	          endif
C    infile='d:\web\dws\yy\mm\wcmmddut.jyr'	   !Tamara
c	outfile='d:\web\graf\dfc\yy\mm\yymmddw.txt'		   !Tamara
      infile(12:13)=syr								   !Tamara
	infile(28:29)=syr								   !Tamara
	outfile(17:18)=syr								   !Tamara
	outfile(23:24)=syr								   !Tamara
C
C
	infile(15:16)=smn								   !Tamara
	infile(20:21)=smn								   !Tamara
	outfile(20:21)=smn								   !Tamara
	outfile(25:26)=smn								   !Tamara

	infile(22:23)=sdy								   !Tamara
	outfile(27:28)=sdy								   !Tamara
C
	infile(27:27)='j'								   !Tamara
	ZZZ=title(1)
	ZZZ(26:40)='               '
c>	if (ldy.eq.nnc-1) then
c>	infile(27:27)='a'								   !Tamara
c>	ZZZ(26:40)=' 1-day forecast'
c>	endif
c>	if (ldy.eq.nnc) then
c>	infile(27:27)='b'								   !Tamara
c>	ZZZ(26:40)=' 2-day forecast'
c>	endif
	title(1)=zzz
C++	
c
c>	if (ldy.eq.nnc-1) outfile(33:33)='a'			   !Tamara
c>	if (ldy.eq.nnc) outfile(33:33)='b'				   !Tamara

	ZZZ=title(2)
	ZZZ(32:34)=ADAY
	ZZZ(37:40)=AYEAR
	 ZZZ(43:44)=SDY
	 ZZZ(46:47)=SMN
	 ZZZ(49:52)=AYEAR
	title(2)=ZZZ

   18	OPEN(10,FILE=outfile)
c	outfile='d:\web\graf\dwc\yy\mn\yymmddw.txt'
	write(10,202) (title(i),i=1,4)
C	write(*,202) (title(i),i=1,4)
	zzz=title(7)
	txxx=zzz(1:38)
	tyyy=zzz(39:60)
C	write(*,1202) txxx,tyyy
	write(10,1202) txxx,tyyy
	zzz=title(8)
	txxx=zzz(1:38)
	tyyy=zzz(39:60)
C	write(*,1202) txxx,tyyy
	write(10,1202) txxx,tyyy
C	write(*,1203) eoh
	write(10,1203) eoh
  202 format(A60)
 1202	format(A38,22X,A22)
 1203	format(60X,A22)
c	lda=ndoy(iyr,mn,idy)

	zzz=title(2)
	zzz(32:34)=aday
	zzz(37:40)=ayear
	zzz(43:44)=sdy
	zzz(46:47)=smn
	zzz(49:52)=ayear
	title(2)=zzz
C
C cycle	UT
C
      do 203 iut=0,23
	call blet2(iut,aut)

	zzz=title(6)
	zzz(3:6)=ayear
	zzz(11:12)=amn
	zzz(17:18)=sdy
	zzz(23:24)=aut
	title(6)=zzz
	infile(24:25)=aut						  !Tamara

      OPEN(11,FILE=INFILE)
C
	zzz=title(5)
	imap=iut+1
	call blet2(imap,amap)
	zzz(5:6)=amap
	title(5)=zzz
C Change 
	zzz=title(5)
 	txxx=zzz(1:38)
	tyyy=zzz(39:60)
C	write(*,1202) txxx,tyyy
	write(10,1202) txxx,tyyy
	zzz=title(6)
 	txxx=zzz(1:38)
	tyyy=zzz(39:60)
C	write(*,1202) txxx,tyyy
	write(10,1202) txxx,tyyy

  107 format(4(A80),A45)
 1071 format(A80)
 1072 format(A45)
 1073 format(3X,F5.1,'-180.0 180.0   5.0',34X,'LAT/LON1/LON2/DLON')
	do i=1,71
COLD	READ (11,107,END=99,ERR=2) TXT !map lines
	i1=72-i
	READ (11,107,END=99,ERR=2) TXT1(i1),txt2(i1),txt3(i1),txt4(i1)
	+,txt5(i1) !map lines LATi(71)=(-87.5),...,LATI(1)=(+87.5)
	enddo
	glat=90.0
	do i=1,71
	glat=glat-2.5
c/	write(*,1073) glat
	write(10,1073) glat
COLD	write(10,107) TXT
c/	write(*,1071) TXT1(i)
c/	write(*,1071) TXT2(i)
c/	write(*,1071) TXT3(i)
c/	write(*,1071) TXT4(i)
c/	write(*,1072) TXT5(i)
	write(10,1071) TXT1(i)
	write(10,1071) TXT2(i)
	write(10,1071) TXT3(i)
	write(10,1071) TXT4(i)
	write(10,1072) TXT5(i)
	enddo

   99	close(unit=11)
  203 continue   ! end ut cycle
      close(unit=10)
 201  CONTINUE				  ! end day-to-day cycle
C
c--	num=num+1
c--	if (num.le.4) then
c--	GOTO 25
c--	            else
       GOTO 33
c==	endif
    2 CONTINUE
       write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
 	pause ' '
	goto 34
   33	continue
C      write(*,*) infile,outfile
c      pause ' ' 

   34  RETURN
       END

