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 =1 - foF2, 2 , 3 (TEC>, 4 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 submapd1(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*66 infile,outfile !Ljuba поменяла 45 на 66 character*41 inf,ou !Ljuba character*41 ile,tfile !Ljuba 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 C infile='d:\web\graf\dwc\yy\mm\ut\wcmmddut.jyr' !Tamara C outfile='d:\web\graf\dfc\yy\mn\yymmddw.txt' !Tamara inf='/var/www/izmiran/ionosphere/weather/graf/' !Ljuba 41 ile='dwc/yy/mm/ut/wcmmddut.jyr' !Ljuba 25 infile=inf//ile !Ljuba ou='/var/www/izmiran/ionosphere/weather/graf/' !Ljuba 41 tfile='dfc/yy/mn/yymmddw.txt' !Ljuba 21 outfile=ou//tfile !Ljuba C Cycle on 4 parameters 25 continue C if (num.eq.1) then fhw='f' C infile(14:15)='fc' ! foF2 !Tamara C infile(26:26)='f' !Tamara C infile(35:35)='j' !Tamara C outfile(14:15)='fc' !Tamara C outfile(29:29)='f' !Tamara infile(43:44)='fc' ! foF2 !Ljuba wc infile(55:55)='f' !Ljuba w infile(64:64)='j' !Ljuba j outfile(43:44)='fc' !Ljuba fc outfile(58:58)='f' !Ljuba w 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 infile(14:15)='hc' ! hmF2 !Tamara C infile(26:26)='h' !Tamara C infile(35:35)='j' !Tamara C outfile(14:15)='hc' !Tamara C outfile(29:29)='h' !Tamara infile(43:44)='hc' ! hmF2 !Ljuba infile(55:55)='h' !Ljuba infile(64:64)='j' !Ljuba outfile(43:44)='hc' !Ljuba outfile(58:58)='h' !Ljuba 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' C infile(14:15)='tc' !Tamara C infile(26:26)='t' !Tamara C infile(35:35)='j' !Tamara C outfile(14:15)='tc' !Tamara C outfile(29:29)='t' !Tamara infile(43:44)='tc' !Ljuba infile(55:55)='t' !Ljuba infile(64:64)='j' !Ljuba outfile(43:44)='tc' !Ljuba outfile(58:58)='t' !Ljuba 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' C infile(14:15)='wc' !Tamara C infile(26:26)='w' !Tamara C infile(35:35)='j' !Tamara C outfile(14:15)='wc' !Tamara C outfile(29:29)='w' !Tamara infile(43:44)='wc' !Ljuba infile(55:55)='w' !Ljuba infile(64:64)='j' !Ljuba outfile(43:44)='wc' !Ljuba outfile(58:58)='w' !Ljuba 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\graf\dwc\yy\mm\ut\wcmmddut.jyr' !Tamara c outfile='d:\web\graf\dfc\yy\mm\yymmddw.txt' !Tamara C infile(17:18)=syr !Tamara C infile(36:37)=syr !Tamara C outfile(17:18)=syr !Tamara C outfile(23:24)=syr !Tamara C infile(46:47)=syr !Ljuba yy infile(65:66)=syr !Ljuba yr outfile(46:47)=syr !Ljuba yy outfile(52:53)=syr !Ljuba C C infile(20:21)=smn !Tamara C infile(28:29)=smn !Tamara C outfile(20:21)=smn !Tamara C outfile(25:26)=smn !Tamara infile(49:50)=smn !Ljuba mm infile(57:58)=smn !Ljuba mm outfile(49:50)=smn !Ljuba mm outfile(54:55)=smn !Ljuba mm C infile(30:31)=sdy !Tamara C outfile(27:28)=sdy !Tamara infile(59:60)=sdy !Ljuba dd outfile(56:57)=sdy !Ljuba dd C C infile(27:27)='c' !Tamara infile(56:56)='c' !Ljuba ZZZ=title(1) ZZZ(26:40)=' ' if (ldy.eq.nnc-1) then C infile(27:27)='a' !Tamara infile(56:56)='a' !Ljuba ZZZ(26:40)=' 1-day forecast' endif if (ldy.eq.nnc) then C infile(27:27)='b' !Tamara infile(56:56)='b' !Ljuba ZZZ(26:40)=' 2-day forecast' endif title(1)=zzz C++ c C outfile(33:33)='t' !Tamara C if (ldy.eq.nnc-1) outfile(33:33)='a' !Tamara C if (ldy.eq.nnc) outfile(33:33)='b' !Tamara outfile(62:62)='t' !Ljuba посл буква if (ldy.eq.nnc-1) outfile(62:62)='a' !Ljuba if (ldy.eq.nnc) outfile(62:62)='b' !Ljuba 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) write(*,202) (title(i),i=1,4) zzz=title(7) txxx=zzz(1:38) tyyy=zzz(39:60) write(*,1202) txxx,tyyy write(10,1202) txxx,tyyy zzz=title(8) txxx=zzz(1:38) tyyy=zzz(39:60) write(*,1202) txxx,tyyy write(10,1202) txxx,tyyy 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 C infile(32:33)=aut !Tamara infile(61:62)=aut !Ljuba 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) write(*,1202) txxx,tyyy write(10,1202) txxx,tyyy zzz=title(6) txxx=zzz(1:38) tyyy=zzz(39:60) 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 ' C pause ' ' !!!!!!!!!!!! Ljuba !!!!!!!!!!!! goto 34 33 continue write(*,*) infile,outfile c pause ' ' 34 RETURN END