C =========================================================== PROGRAM EXTSEC15dd C....................................................June 2026 C New giro data files C Add produce tk(ns) C C Extract prec. data from monthly files C c DIMENSION IF2(31,24),IM3(31,24),IH2(31,24), ! *IM(0:12) ! CHARACTER*128 outfile1,outfile2,ctext,outfile3 !MAR2020 +,infile1,infile2,infile3,insodf,insodm CHARACTER*120 m_data C# CHARACTER*41 basef !!!! Ljuba!DEC2013 C# CHARACTER*19 inf1,inf2,inf3 !!!! Ljuba!DEC2013 ++++++++++++++++++ CHARACTER*10 CCM !MAR2020 CHARACTER*16 indate !FEB2015 Tamara !!!!!!!!!!!!!!! CHARACTER*30 STNAME ! CHARACTER*15 STITLE(81),TITLES !FEB2015 CHARACTER*4 YEAR,YEAR_pre !FEB2015 CHARACTER*6 YYMMDD,Y0M0D0,Y1M1D1 CHARACTER*9 IONO LOGICAL NEWMN ! CHARACTER*2 ST,AMN,DY1,DY2,DDD,CDAY(0:31),DD1,DD2,YY ! *,FULF(81),FULM(81),DY22,STS(81),AMN_pre,ADY_pre !FEB2015 *,AMN1,AYR1,AMN0,AYR0,AYR_nex,AMN_nex,ADY_nex ! +,AMN_cur,CYR,CMN,CDY C- CHARACTER*1 yn DATA IM/31,31,28,31,30,31,30,31,31,30,31,30,31/ ! DATA STS/ + 'as','at','bc','br','cb','cn','cq','bj','cw','jb' ! +,'db','dw','eg','eb','ga','bb','gu','ha','he','ho' ! +,'jj','jm','jr','kk','lm','ml','mo','mq','mw','nd' +,'ni','ok','pe','pq','rm','ro','vt','pf','tv','tr' !May 2024 +,'wk','wp','wz','gm','so','ff','kh','nc','mm','tk' ! +,'bp','ch','sa','ei','gg','if','tu','ns','kg','mg' ! +,'sd','rv','ma','pa','fz','au','al','yg','bl','ea' ! +,'mh','ic','di','gr','wa','sp','cj','er','ll','ad' !May 2024 +,'qn'/ ! C DATA STITLE/ + 'Ascension. ','Athens. ','Boulder. ' !=== Apr 2017 +,'Brisbane. ','Canberra. ','Camden. ' !=== Apr 2017 +,'Chongqing. ','Boa_Vista ','Casey. ' !=== May 2026 +,'Jang_Bodo. ','Dourbes. ','Darwin. ' !=== Mar 2020 +,'Eglin. ','Roquetes. ','Gakona. ' !=== Apr 2017 +,'Bahia_Blanca.','Guangzhou. ' !=== May 2018 +,'Hainan. ','Hermanus. ','Hobart. ' !=== Apr 2017 +,'Jeju. ','Jicamarca. ','Juliusruh. ' !=== Apr 2017 +,'Kokubunji. ','Learmonth. ','Manzhouli. ' !=== Apr 2017 +,'Moscow. ','MacQuarue_Is.','Mawson. ' ! +,'Niue. ','Norfolk_Is. ','Okinawa. ' !=== Apr 2017 +,'Perth. ','Pruhonice. ','Ramey. ' !=== Apr 2017 C +,'Rome. ','San_Vito. ','Scott_Base. ' !May 2024 +,'Rome. ','San_Vito. ','Poker_Flat. ' !May 2024 +,'Townsville. ','Tromso. ','Wakkanai. ' !=== Apr 2017 +,'Wallops. ','Warsaw. ','Gibilmanna. ' !Nov 2020 +,'Sodankyla. ','Fairford. ','Khabarovsk. ' !=== Apr 2017 +,'Nicosia. ','Murmansk. ','Tomsk. ' !APR 2020 +,'Beijing. ','Chilton. ','Sao_Luis. ' !=== Mar 2020 +,'Eielson. ','Guam. ','Idaho_NL. ' !=== Apr 2017 +,'Tucuman. ','Novosibirsk. ','Kaliningrad. ' !=== May 2018 +,'Magadan. ','Salekhard. ','Rostov. ' !=== Apr 2017 +,'IPG-Moscow. ','Pt_Arguello. ','Fortaleza ' !=== May 2018 +,'Austin. ','Alpena. ','Yamagawa. ' !=== Jun 2017 +,'Belem. ','Arenosillo. ','MillstonHill.' ! Jan. 2021 +,'I_Cheon. ','Dikson. ','Grahamstown. ' ! Aug 2020 C +,'San_Juan. ','Sopron. ','Cachoeira. ' !May 2024 +,'Wake. ','Sopron. ','Cachoeira. ' !May 2024 +,'Eareckson. ','Lualualei. ','Ashkhabad. ' !Sep. 2019 +,'Thule. '/ C COMMON /BL1/ST,YEAR,YY,AMN,DY1,DY2,DD1,DD2,ID1,ID2,JF,JH,JT,DY22, *STNAME COMMON /BL4/ FULF,FULM,NFULF,NFULM,MAXD2 C C Start: C IONO='_iono.txt' NEWMN=.FALSE. id2=0 insodf='c:/web/grif/2026/so26f.br' insodm='c:/web/grif/2026/so26m.br' C C Use current year, month, day from file DATE: !FEB2015 C 799 format(A4,2(1X,A2),1X,A4,2(1X,A2),2(1X,I3)) !FEB2015 NEW COMMAND NUMBER = 799 798 format(' YEAR, AMN, DD2 = ',A4,2(1X,A2),1X,A4,2(1X,A2),2(1X,I3)) indate='c:/web/graf/date' !!! Tamara !!!!!!! !FEB2015 C# indate='/var/www/izmiran/ionosphere/weather/graf/date' !!! LIUBA !!FEB2015 open(10,file=indate) !FEB2015 read(10,799) YEAR,AMN_cur,DD2,YEAR_pre,AMN_pre,ADY_pre +,lda_cur,lda_pre !FEB2015 NEW FORMAT NUMBER = 799 WRITE(*,798) YEAR, AMN_cur, DD2,YEAR_pre,AMN_pre,ADY_pre !FEB2015 NEW FORMAT NUMBER = 798 +,lda_cur,lda_pre close(unit=10) AMN=AMN_cur C WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TTT !FEB2015 C YEAR=DD(1:4) !FEB2015 YY=YEAR(3:4) YYMMDD(1:2)=YY YYMMDD(3:4)=AMN YYMMDD(5:6)=DD2 Y0M0D0=YYMMDD C++ read(YY,*) ryr ! iyr=int(ryr) ! z1=iyr/4.0 ! jz1=int(z1)*4 ! IF(jz1.EQ.iyr) THEN ! IM(2)=29 ! ELSE ! IM(2)=28 ! ENDIF ! C+ kyr_nex=iyr read(AMN,*) rmn ! kmn=int(rmn) read(DD2,*) rdy ! kdy=int(rdy) kdy_nex=kdy+1 kmn_nex=kmn if (kdy_nex.gt.im(kmn)) then kdy_nex=1 kmn_nex=kmn+1 if (kmn_nex.gt.12) then kmn_nex=1 kyr_nex=iyr+1 endif endif call blet2(kyr_nex,AYR_nex) call blet2(kmn_nex,AMN_nex) call blet2(kdy_nex,ADY_nex) Y1M1D1(1:2)=AYR_nex Y1M1D1(3:4)=AMN_nex Y1M1D1(5:6)=ADY_nex DY1=ADY_pre DY2=DD2 if (DD2.eq.'01') NEWMN=.TRUE. ! C CCM=YEAR CCM(5:5)=' ' CCM(6:7)=AMN CCM(8:8)=' ' C C------------------------------------------------------------------------- !MAR2024 st='he' c+ call subhegrfh1(st) !he -gr call subhegrfh2(st) !he +gr st='gr' call subhegrfh2(st) !he +gr write(*,*) ' Check GR & HE:' pause ' ' C C START CYCLE ON STATIONS C DO 1500 ista=1,81 !FEB2015 st=sts(ista) C 1999 C IF (ista.eq.1) GOTO 1500 C Lowell stations IF ((ista.eq.2).or.(ista.eq.4).or.(ista.eq.5).or.(ista.eq.10) +.or.(ista.eq.19).or.(ista.eq.35).or.(ista.eq.74)) GOTO 1500 ! IF ((ista.eq.8).or.(ista.eq.11).or.(ista.eq.12).or.(ista.eq.13) +.or.(ista.eq.14).or.(ista.eq.15).or.(ista.eq.16).or.(ista.eq.20) +.or.(ista.eq.21).or.(ista.eq.22).or.(ista.eq.23).or.(ista.eq.25) +.or.(ista.eq.30).or.(ista.eq.31).or.(ista.eq.33).or.(ista.eq.34) +.or.(ista.eq.36).or.(ista.eq.37).or.(ista.eq.38).or.(ista.eq.39) +.or.(ista.eq.40).or.(ista.eq.42).or.(ista.eq.43).or.(ista.eq.44) c +.or.(ista.eq.46).or.(ista.eq.48).or.(ista.eq.52).or.(ista.eq.54) +.or.(ista.eq.46).or.(ista.eq.48).or.(ista.eq.54) ! May 2026 +.or.(ista.eq.56).or.(ista.eq.57).or.(ista.eq.59) +.or.(ista.eq.60).or.(ista.eq.61).or.(ista.eq.62).or.(ista.eq.63) +.or.(ista.eq.64).or.(ista.eq.65).or.(ista.eq.66).or.(ista.eq.67) +.or.(ista.eq.69).or.(ista.eq.70).or.(ista.eq.71).or.(ista.eq.72) +.or.(ista.eq.75).or.(ista.eq.76).or.(ista.eq.77) +.or.(ista.eq.78).or.(ista.eq.79).or.(ista.eq.81)) goto 1500 C# OUTFILE1='/var/www/izmiran/ionosphere/weather/graf/2010/styrf.br' !Ljuba OUTFILE1='c:/web/graf/2010/styrf.br' !Tamara C# outfile1(42:45)=YEAR !Ljuba outfile1(13:16)=YEAR !Tamara C# outfile1(49:50)=YY !Ljuba outfile1(20:21)=YY !Tamara outfile2=outfile1 C# outfile2(51:51)='m' !Ljuba outfile2(22:22)='m' !Tamara outfile3=outfile1 C# outfile3(51:51)='h' !!Ljuba outfile3(22:22)='h' !Tamara write(*,*) '1) outfiles:' !c// write(*,*) 'outfile1=', ST, outfile1 write(*,*) 'outfile2=', ST, outfile2 write(*,*) 'outfile3=', ST, outfile3 write(*,*) '--------' c C NEW...................................................Read ch from RAL chilton_iono.txt: IF (ista.eq.52) THEN ! ch st='ch' outfile1(18:19)=st outfile2(18:19)=st outfile3(18:19)=st C call subngd3ch(st) Crem call SUBSEC2ral(iyr,lda_pre,lda_cur,outfile1,outfile2,outfile3) goto 1500 ENDIF C ------------------------------------------------------------ C NEW source data files: infile1='c:/web/graf/dat1/12/styrmn.txt' !Tamara !DEC2013 C infile1='/var/www/izmiran/ionosphere/weather/grif/dat1/12/styrmn.txt' !Ljuba!DEC2013 C# basef='/var/www/izmiran/ionosphere/weather/graf/' !Ljuba!DEC2013 Замена grif на graf 18.04.2014 C# inf1='dat1/12/styrmn.txt' !Ljuba!DEC2013 C# infile1=basef//inf1 !Ljuba!DEC2013 C# write(*,*) 'infile1=', infile1 !Ljuba!DEC2013 infile1(18:19)=YY !Tamara !DEC2013 C# infile1(47:48)=YY !Ljuba !DEC2013 infile1(23:24)=YY !Tamara !DEC2013 C# infile1(52:53)=YY !Ljuba !DEC2013 C infile2='c:/web/graf/dat5/12/styrmnm.txt' !Tamara !DEC2013 C infile2='/var/www/izmiran/ionosphere/weather/grif/dat5/12/styrmnm.txt' !Ljuba !DEC2013 99 continue !FEB2015 Tamara C# inf2='dat5/12/styrmnm.txt' !Ljuba!DEC2013++++++++++++++++++++++++++++++++ C# infile2=basef//inf2 !Ljuba!DEC2013 infile2='c:/web/graf/dat5/12/styrmnm.txt' !Tamara !DEC2013 infile2(18:19)=YY !Tamara !DEC2013 C# infile2(47:48)=YY !Ljuba !DEC2013 infile2(23:24)=YY !Tamara !DEC2013 C# infile2(52:53)=YY !Ljuba !DEC2013 C infile3='c:/web/graf/dat6/12/styrmnh.txt' !Tamara !DEC2013 C infile3='/var/www/izmiran/ionosphere/weather/grif/dat6/12/styrmnh.txt' !Ljuba !DEC2013 98 continue !FEB2015 Tamara infile3='c:/web/graf/dat6/12/styrmnh.txt' !Tamara !DEC2013 C# inf3='dat6/12/styrmnh.txt' !Ljuba!DEC2013++++++++++++++++++++++++++++++ C# infile3=basef//inf3 !Ljuba!DEC2013 infile3(18:19)=YY !Tamara !DEC2013 C# infile3(47:48)=YY !Ljuba !DEC2013 infile3(23:24)=YY !Tamara !DEC2013 C# infile3(52:53)=YY !Ljuba !DEC2013 write(*,*) '2) infiles:' !c// write(*,*) 'infile1=', infile1 write(*,*) 'infile2=', infile2 write(*,*) 'infile3=', infile3 write(*,*) '--------' C C 299 STNAME(1:6)=YYMMDD TITLES=STITLE(ista) do k=2,15 if (titles(k:k).eq.'.') then !*** kk=k-1 exit endif enddo stname(7:)=titles(1:kk) kkk=kk+7 stname(kkk:)=iono ST=STS(ista) C# OUTFILE1(47:48)=ST !Ljuba OUTFILE1(18:19)=ST !Tamara write(*,*) ST, outfile1 C# OUTFILE2(47:48)=ST !Ljuba OUTFILE2(18:19)=ST !Tamara C# OUTFILE3(47:48)=ST !Ljuba OUTFILE3(18:19)=ST !Tamara write(*,*) '3) outfiles:' !c// write(*,*) 'outfile1=', ST, outfile1 write(*,*) 'outfile2=', ST, outfile2 write(*,*) 'outfile3=', ST, outfile3 write(*,*) '--------' CC blank data: IF (ista.eq.45) THEN OPEN(12,file=OUTFILE1) OPEN(13,file=OUTFILE2) c- OPEN(14,file=OUTFILE3) ! OPEN(17,file=INSODF,action='READ') OPEN(18,file=INSODM,action='READ') 1497 read(17,188,end=1498) CYR,CMN,CDY,m_data write(*,188) CYR,CMN,CDY,m_data write(12,188) CYR,CMN,CDY,m_data 1498 read(18,188,end=1496) CYR,CMN,CDY,m_data write(*,188) CYR,CMN,CDY,m_data write(13,188) CYR,CMN,CDY,m_data 1496 IF ((CMN.eq.AMN_cur).and.(CDY.eq.DD2)) THEN close(12) close(13) close(17) close(18) ! C GOTO 1494 GOTO 1500 ! end cycle of stations else GOTO 1497 ENDIF ENDIF 1494 CONTINUE CC jf=1 jh=1 jt=2 Cnorn if (ista.eq.1) then !++++================ if (id2.eq.0) then !++++================A read(dd2,*) rdy2 id2=int(rdy2) nndy2=id2 C--- endif !++++ C +++++++++++++++++++++++++++ ! C ! read(AMN,*) rmn ! imn=int(rmn) ! imn1=imn ! iyr1=iyr ! C NEW preceding day for start of month: ! IF (.not.NEWMN) THEN !1 id1=id2-1 ! ELSE ! 1 call submmdd(lda_pre,iyr,imn1,id1) ENDIF ! 1 ENDIF !+++++====================== call blet2(imn1,AMN1) ! call blet2(iyr1,AYR1) ! AMN=AMN1 ! YY=AYR1 ! CCM(3:4)=YY ! CCM(6:7)=AMN ! C C call blet2(id1,DD1) C ------------------------------------------------------- C Read data of prec month for the station: imn0=imn-1 iyr0=iyr if (imn0.eq.0) then imn0=12 iyr0=iyr0-1 endif call blet2(imn0,AMN0) call blet2(iyr0,AYR0) C Missed Insert zero =>>> if ((ista.eq.3).or.(ista.eq.6).or.(ista.eq.7).or.(ista.eq.9) +.or.(ista.eq.10) !bc,cn,cq,jb +.or.(ista.eq.17).or.(ista.eq.18) +.or.(ista.eq.24).or.(ista.eq.26).or.(ista.eq.28).or.(ista.eq.29) +.or.(ista.eq.32).or.(ista.eq.35).or.(ista.eq.41) !ha,kk,ml + !wk, so +.or.(ista.eq.47).or.(ista.eq.49).or.(ista.eq.51).or.(ista.eq.53) +.or.(ista.eq.55).or.(ista.eq.68) ! !'kh','mm',bp,gg +.or.(ista.eq.73) !di +.or.(ista.eq.80)) + goto 1495 !ad C + endif CC C infile1(21:22)=ST !Tamara !DEC2013 C# infile1(50:51)=ST !Ljuba !DEC2013 infile2(21:22)=ST !Tamara !DEC2013 C# infile2(50:51)=ST !Ljuba !DEC2013 infile3(21:22)=ST !Tamara !DEC2013 C# infile3(50:51)=ST !Ljuba !DEC2013 write(*,*) '4) intfiles:' !c// write(*,*) 'infile1=', ST, infile1 write(*,*) 'infile2=', ST, infile2 write(*,*) 'infile3=', ST, infile3 write(*,*) '--------' C infile1(18:19)=AYR0 !Tamara DEC2013 C# infile1(47:48)=AYR0 !Ljuba DEC2013 infile1(23:24)=AYR0 !Tamara DEC2013 C# infile1(52:53)=AYR0 !Ljuba DEC2013 infile1(25:26)=AMN0 !Tamara C# infile1(54:55)=AMN0 !Ljuba DEC2013 infile2(18:19)=AYR0 !Tamara DEC2013 C# infile2(47:48)=AYR0 !Ljuba DEC2013 infile2(23:24)=AYR0 !Tamara DEC2013 C# infile2(52:53)=AYR0 !Ljuba DEC2013 infile2(25:26)=AMN0 !Tamara C# infile2(54:55)=AMN0 !Ljuba DEC2013 infile3(18:19)=AYR0 !Tamara DEC2013 C# infile3(47:48)=AYR0 !Ljuba DEC2013 infile3(23:24)=AYR0 !Tamara DEC2013 C# infile3(52:53)=AYR0 !Ljuba DEC2013 infile3(25:26)=AMN0 !Tamara C# infile3(54:55)=AMN0 !Ljuba write(*,*) '5) infiles:' !c// write(*,*) 'infile1=', ST, infile1 write(*,*) 'infile2=', ST, infile2 write(*,*) 'infile3=', ST, infile3 write(*,*) '--------' nd0=im(imn0) OPEN(15,file=INFILE1) OPEN(12,file=OUTFILE1) do i=1,4 read(15,89) ctext ! extra lines enddo do i=1,nd0 read(15,89) ctext write(12,89) ctext enddo close(unit=15) C OPEN(15,file=INFILE2) OPEN(13,file=OUTFILE2) do i=1,4 read(15,89) ctext ! extra lines enddo do i=1,nd0 read(15,89) ctext write(13,89) ctext enddo close(unit=15) C OPEN(15,file=INFILE3) OPEN(14,file=OUTFILE3) do i=1,4 read(15,89) ctext ! extra lines enddo do i=1,nd0 read(15,89) ctext write(14,89) ctext enddo close(unit=15) C C Read data of current month for the station: C infile1(18:19)=AYR1 !Tamara DEC2013 infile2(18:19)=AYR1 !Tamara DEC2013 infile3(18:19)=AYR1 !Tamara DEC2013 infile1(23:24)=AYR1 !Tamara DEC2013 infile2(23:24)=AYR1 !Tamara DEC2013 infile3(23:24)=AYR1 !Tamara DEC2013 infile1(25:26)=AMN !Tamara DEC2013 infile2(25:26)=AMN !Tamara DEC2013 infile3(25:26)=AMN !Tamara DEC2013 C infile1='/var/www/izmiran/ionosphere/weather/grif/dat1/12/styrmn.txt' !Ljuba DEC2013 C# infile1(47:48)=AYR1 !Ljuba DEC2013 C# infile2(47:48)=AYR1 !Ljuba DEC2013 C# infile3(47:48)=AYR1 !Ljuba DEC2013 C# infile1(52:53)=AYR1 !Ljuba DEC2013 C# infile2(52:53)=AYR1 !Ljuba DEC2013 C# infile3(52:53)=AYR1 !Ljuba DEC2013 C# infile1(54:55)=AMN !Ljuba DEC2013 C# infile2(54:55)=AMN !Ljuba DEC2013 C# infile3(54:55)=AMN !Ljuba DEC2013 write(*,*) '6) infiles:' !c// write(*,*) 'infile1=', ST, infile1 write(*,*) 'infile2=', ST, infile2 write(*,*) 'infile3=', ST, infile3 write(*,*) '--------' jj=nd0 ! jj days for prec month nd0=id1-1 jj=jj+nd0 ! jj days for two months if (nd0.eq.0) goto 1 OPEN(15,file=INFILE1) do i=1,4 read(15,89) ctext ! extra lines enddo do i=1,nd0 read(15,89) ctext write(12,89) ctext enddo close(unit=15) C OPEN(15,file=INFILE2) do i=1,4 read(15,89) ctext ! extra lines enddo do i=1,nd0 read(15,89) ctext write(13,89) ctext enddo close(unit=15) C OPEN(15,file=INFILE3) do i=1,4 read(15,89) ctext ! extra lines enddo do i=1,nd0 read(15,89) ctext write(14,89) ctext enddo close(unit=15) C C AVOID COMMANDS OF READING OLD FILES *.br C# GOTO 1 ! DEC2013 89 format(A128) ! DEC2013 C DELETED COMMANDS BEFORE 1 CONTINUE ! DEC2013 C----------------------------------------------------------------- 1 continue C =================================== kfulf=0 kfulm=0 C DO 77 JD=id1,id2 ! day-to-day cycle jd=id1 call blet2(jud,DDD) CDAY(JD)=DDD C CCM(9:10)=DDD ist=0 C+++ CREM if (jd.eq.id1) then STNAME(1:6)=Y0M0D0 C C+ NS if ((ista.eq.58).and.(jd.eq.id1)) then close(unit=12) close(unit=13) close(unit=14) call subionka3c(if2,im3,ih2) ! NS endif C check full sets of foF2, M3F2 at DAY2: cntf=0 cntm=0 do n=1,24 if (IF2(JD,n).GT.999) IF2(JD,n)=0 ! if (IH2(JD,n).GT.999) IH2(JD,n)=0 ! if (IM3(JD,n).GT.999) IM3(JD,n)=0 ! if (IF2(JD,n).gt.0) cntf=cntf+1 if (jh.eq.1) then if (IM3(JD,n).gt.0) cntm=cntm+1 endif enddo !+APR 2020 if (cntf.eq.24) then kfulf=kfulf+1 endif if ((jh.eq.1).and.(cntm.eq.24)) then kfulm=kfulm+1 endif C C Output zero data for Missed stations/data C 1495 if((ista.eq.3).or.(ista.eq.6).or.(ista.eq.7).or.(ista.eq.9) +.or.(ista.eq.10).or.(ista.eq.16).or.(ista.eq.17).or.(ista.eq.18) +.or.(ista.eq.24).or.(ista.eq.26).or.(ista.eq.28).or.(ista.eq.29) +.or.(ista.eq.32).or.(ista.eq.35) !ha,kk,ml !mq, so Nov 2024 +.or.(ista.eq.41).or.(ista.eq.47).or.(ista.eq.49) !ok,kr,mm +.or.(ista.eq.51).or.(ista.eq.53).or.(ista.eq.55).or.(ista.eq.57) +.or.(ista.eq.68).or.(ista.eq.73).or.(ista.eq.80)) then !sj,ad !bp,yg,di Aug 2024 C do n=1,24 IF2(JD,n)=0 ! IH2(JD,n)=0 ! IM3(JD,n)=0 ! enddo C C SO from plot C C 188 FORMAT(3A2,A120) call blet2(id1,DY22) icnt=0 i_cnt=0 OPEN(12,file=OUTFILE1) 151 read(12,188,end=244) CYR,CMN,CDY,m_data C if ((CYR.eq.YY).and.(CMN.eq.AMN).and.(CDY.eq.DY22)) THEN !B if ((CYR.eq.YY).and.(CMN.eq.AMN).and.(CDY.eq.ADY_pre)) THEN !B Jan 2025 goto 244 else icnt=icnt+1 !B goto 151 endif 244 i_cnt=icnt !B rewind (12) icnt=0 do while (icnt.lt.i_cnt) read(12,188,end=248) CYR,CMN,CDY,m_data icnt=icnt+1 enddo 248 print*,'YES!',st ENDFILE 12 close(12) OPEN(12,file=OUTFILE1,access='APPEND') ! C icnt=0 i_cnt=0 OPEN(13,file=OUTFILE2) 152 read(13,188,end=245) CYR,CMN,CDY,m_data c if ((CYR.eq.YY).and.(CMN.eq.AMN).and.(CDY.eq.DY22)) THEN !C if ((CYR.eq.YY).and.(CMN.eq.AMN).and.(CDY.eq.ADY_pre)) THEN !C Jan 2025 goto 245 else !C icnt=icnt+1 goto 152 endif !C 245 i_cnt=icnt rewind (13) icnt=0 do while (icnt.lt.i_cnt) read(13,188,end=249) CYR,CMN,CDY,m_data icnt=icnt+1 enddo 249 print*,'YES!',st ENDFILE 13 close(13) OPEN(13,file=OUTFILE2,access='APPEND') ! C icnt=0 i_cnt=0 OPEN(14,file=OUTFILE3) ! 153 read(14,188,end=246) CYR,CMN,CDY,m_data if ((CYR.eq.YY).and.(CMN.eq.AMN).and.(CDY.eq.ADY_pre)) THEN ! Jan 2025 goto 246 else icnt=icnt+1 goto 153 endif 246 i_cnt=icnt rewind (14) icnt=0 do while (icnt.lt.i_cnt) read(14,188,end=250) CYR,CMN,CDY,m_data icnt=icnt+1 enddo 250 print*,'YES!',st ENDFILE 14 179 close(14) OPEN(14,file=OUTFILE3,access='APPEND') ! C C DO 77 ndy=id1,id2 DO 77 lda=lda_pre,lda_cur call submmdd(lda,iyr,nmn,ndy) call blet2(nmn,AMN) call blet2(ndy,DY22) c write(*,88) YY,AMN,DY22,(IF2(JD,k),k=1,24) write(12,88) YY,AMN,DY22,(IF2(JD,k),k=1,24) c if (jh.eq.1) then write(13,88) YY,AMN,DY22,(IM3(JD,k),k=1,24) ! write(*,88) YY,AMN,DY22,(IM3(JD,k),k=1,24) ! C write(14,88) YY,AMN,DY22,(IH2(JD,k),k=1,24) ! write(*,88) YY,AMN,DY22,(IH2(JD,k),k=1,24) ! endif CLOSE (unit=11) 77 continue ! go to the next day 1499 CONTINUE ! Nov. 2024 endif !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> !A 88 format(3A2,2X,24(I3,2X)) ! C End of daily cycle =============== C goto 2 3 write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY ' 2 continue CLOSE (unit=12) if (jh.eq.1) then CLOSE (unit=13) CLOSE (unit=14) ! endif 1500 CONTINUE ! End cycle on SEC stations C C Add IPG stations C DO nst=59,63 st=sts(nst) call subipg_dx1c(st) ENDDO C C Lowell stations C DO 181 nst=1,81 IF ((nst.eq.1).or.(nst.eq.2).or.(nst.eq.4).or.(nst.eq.5) +.or.(nst.eq.8).or.(nst.eq.10).or.(nst.eq.11).or.(nst.eq.12) !at, br.cb,cs +.or.(nst.eq.13).or.(nst.eq.14).or.(nst.eq.15).or.(nst.eq.16) +.or.(nst.eq.19).or.(nst.eq.20) !db,dw,eb +.or.(nst.eq.21).or.(nst.eq.22).or.(nst.eq.23).or.(nst.eq.25) +.or.(nst.eq.30).or.(nst.eq.31).or.(nst.eq.33).or.(nst.eq.34) +.or.(nst.eq.36).or.(nst.eq.37).or.(nst.eq.38) !ho,jr,nd 20 +.or.(nst.eq.39).or.(nst.eq.40).or.(nst.eq.42).or.(nst.eq.43) !Aug 2024 +.or.(nst.eq.44).or.(nst.eq.46).or.(nst.eq.48).or.(nst.eq.54) !May 2026 +.or.(nst.eq.56).or.(nst.eq.57).or.(nst.eq.64).or.(nst.eq.65) +.or.(nst.eq.66).or.(nst.eq.67).or.(nst.eq.69).or.(nst.eq.70) +.or.(nst.eq.71).or.(nst.eq.72).or.(nst.eq.74) ! 'gr' N74 +.or.(nst.eq.75).or.(nst.eq.76) !ea,sp,qn May 2024 +.or.(nst.eq.77).or.(nst.eq.78).or.(nst.eq.79).or.(nst.eq.81)) + then C st=sts(nst) ELSE GOTO 181 ENDIF call subngdc3c(st) !foF2 hmF2 181 CONTINUE C CC Mos c++ if (ista.eq.27) then !06.07.2022 c++ st='mo' call subextmos1 !06.07.2022 c++ GOTO 1500 C++ endif 1501 CONTINUE C CC Fill gaps !06.07.2022 c- call subfillgaps('eb','gm',0.7688,20.3572) C- call subfillgaps('tk','ns',1.0347,-0.7287) call subfillgaps('ch','ff',1.05,0.0) C- call subfillgaps('ic','jj',0.9167,12.2719) c- call subfillgaps('pa','au',0.6572,28.5993) c- call subfillgaps('pa','wp',0.5596,36.629) c- call subfillgaps('tr','so',0.9299,4.2130) c- call subfillgaps('jr','wz',0.9780,4.7883) pause ' ' STOP END C subroutine blet2(ilet,alet2) c nn=1,2,3,4 CHARACTER*1 IN(0:9) C INTEGER*2 ilet !FEB2015 DATA IN/'0','1','2','3','4','5','6','7','8','9'/ CHARACTER*2 alet2 CLjuba a2='00' alet2='00' ! j10=ilet/10 j1=ilet-j10*10 5 do i=0,9 if (j10.eq.i) then alet2(1:1)=IN(i) endif enddo 7 do i=0,9 if (j1.eq.i) then alet2(2:2)=IN(i) endif enddo return end C