C =========================================================== SUBROUTINE SUBSEC2ral(iyr,lda1,lda2,out1,out3,out4) C ...................................................................May. 2026 C ............Send results to web/graf/YEAR/styrf.br, styrm.br, styrh.br C C Send output results to c:\web\idce\styr.br files..................23.12.2009 C c EXTRACT HOURLY "FOF2 & M3000" from RAL FILES /daily c INPUT c:\web\graf\\YEAR\Station_iono.TXT OUTPUT STMNf2.br ~ m3.br ~ tc.br DIMENSION IFF(31,0:23),IMM(31,0:23) +,IHH(31,0:23) c- +,xf2(0:23),xm3(0:23),xhm(0:23) C? INTEGER*2 NFULF,NFULM,MAXD2,ID1,ID2 CHARACTER*128 infile,out1,out3,out4,txt ! outfiles graf/YEAR/styrf. m., h.br CHARACTER*10 title,aa CHARACTER*4 YEAR CHARACTER*2 AMN,DY1,YY,ADY +,CYR,CMN,CDY +,ifc(0:23) C Start: infile='c:/web/graf/YEAR/MN/Chilton_iono.txt' call submmdd(lda1,iyr,imn1,idy1) call blet2(imn1,AMN) call blet2(idy1,DY1) C call blet2(iyr,YY) YEAR='2000' YEAR(3:4)=YY infile(13:16)=YEAR infile(18:19)=AMN C C 1 continue C New: c- if (st.eq.'ch') then xlat=51.6 xlon=358.7 c- endif 333 format(A128) open(11,file=out1) ! open(13,file=out3) ! open(14,file=out4) ! icn1=0 icn3=0 icn4=0 55 READ(11, 333, END=44) txt CYR=txt(1:2) CMN=txt(3:4) CDY=txt(5:6) if ((cyr.eq.yy).and.(cmn.eq.amn).and.(cdy.eq.dy1)) then goto 44 else icn1=icn1+1 GOTO 55 CONTINUE endif 44 mf_strings = icn1 REWIND (11) icount=0 do while (icount.lt.mf_strings) READ(11, 333, END=444) txt icount=icount+1 enddo 444 print*,'YES!' ENDFILE 11 close(UNIT=11) CCC 155 READ(13, 333, END=144) txt CYR=txt(1:2) CMN=txt(3:4) CDY=txt(5:6) if ((cyr.eq.yy).and.(cmn.eq.amn).and.(cdy.eq.dy1)) then goto 144 else icn3=icn3+1 GOTO 155 CONTINUE endif 144 mm_strings = icn3 REWIND (13) icount=0 do while (icount.lt.mm_strings) READ(13, 333, END=1444) txt icount=icount+1 enddo 1444 print*,'YES!' ENDFILE 13 close(UNIT=13) CCC 255 READ(14, 333, END=244) txt CYR=txt(1:2) CMN=txt(3:4) CDY=txt(5:6) if ((cyr.eq.yy).and.(cmn.eq.amn).and.(cdy.eq.dy1)) then goto 244 else icn4=icn4+1 GOTO 255 CONTINUE endif 244 mh_strings = icn4 REWIND (14) icount=0 do while (icount.lt.mh_strings) READ(14, 333, END=2444) txt icount=icount+1 enddo 2444 print*,'YES!' ENDFILE 14 close(UNIT=14) CCC C =================================== open(11,file=out1,access='APPEND') ! open(13,file=out3,access='APPEND') ! open(14,file=out4,access='APPEND') ! CC============================================ CC CC DO 77 JD=jd1,jd2 ! day-to-day cycle DO 77 lda=lda1,lda2 ! day-to-day cycle call submmdd(lda,iyr,imn,jd) call blet2(jd,ADY) call blet2(imn,AMN) infile(18:19)=AMN C OPEN(12,FILE=INFILE) 10 read (12,150,err=3,end=76) title read (12,150,err=3,end=76) title kfulf=0 kfulh=0 kfulm=0 do k=0,23 iff(jd,k)=0 ihh(jd,k)=0 imm(jd,k)=0 ifc(k)=' ' ! NEW enddo C define day for comparison: c- call blet2(jd,DDD) c- CDAY(JD)=DDD C c- CCM(9:10)=DDD ist=0 150 format(A10) 11 continue c C ----------------------------------------------- LT=0 ! Start hour-to-hour cycle 220 IFL=0 ICNF2=0 ! count for data within [LT1,LT1+1] SHRF2=0. ICNH2=0 ! count for data within [LT1,LT1+1] SHRH2=0. ICNM3=0 SHRM3=0. 280 read (12,160,err=3,end=400) AA,IDY,LTH,LTM,F2M,AM3 !RAL 160 FORMAT(A8,I2,2(1X,I2),33X,1X,F5.2,7X,F6.3) if ((f2m.lt.0.).or.(f2m.gt.99.)) f2m=0. if ((am3.lt.0.).or.(am3.gt.99.)) am3=0. C 290 if (idy.ne.jd) then 290 if (idy.lt.jd) then goto 280 endif C IF (idy.gt.jd) THEN !-------------- backspace(12) goto 400 ENDIF ! ------------ C c- ENDIF ! ------------ C LT1=LT : 390 IF (LTH.eq.LT) THEN ! if (f2m.gt.0.) then !! ICNF2=ICNF2+1 SHRF2=SHRF2+f2m endif if (AM3.gt.0.) then !! ICNM3=ICNM3+1 SHRM3=SHRM3+AM3 endif goto 280 ENDIF ! 400 continue iff(jd,lt)=0 if(icnf2.gt.0) then iff(jd,lt)=nint(SHRF2/icnf2*10.) endif ihh(jd,lt)=0 imm(jd,lt)=0 if(icnm3.gt.0) then imm(jd,lt)=nint(SHRM3/icnm3*100.) endif C---------------------------------------- lt=lt+1 630 IF (lt.lt.24) then GOTO 220 else goto 70 endif C C No data for particular day: 70 if (ist.eq.0) then write(*,*) "No data for day:",jd endif C C check full sets of foF2, M3F2 at DAY2: C cntf=0 cnth=0 cntm=0 do n=0,23 if (IFF(JD,n).gt.0) cntf=cntf+1 c- if (IHH(JD,n).gt.0) cnth=cnth+1 if (IMM(JD,n).gt.0) cntm=cntm+1 enddo if (cntf.eq.24) then kfulf=kfulf+1 endif c- if (cnth.eq.24) then c- kfulh=kfulh+1 c- endif if (cntm.eq.24) then kfulm=kfulm+1 endif Ctemp endif C Add hmF2 calculation if ((cnth.lt.24).and.(cntm.gt.0)) then xlat=glat xlon=glon c- xdip=dip c-- call subhmf2(xlat,xlon,jd,xf2,xm3,xhm) glat=xlat glon=xlon c- dip=xdip c- do k=0,23 C-- ihh(jd,k)=nint(xhm(k)) c- ihh(jd,k)=0 c- enddo endif C C Write results in web\graf\YEAR\ outfiles: write(*,178) YY,amn,ady,(iff(jd,k),ifc(k),k=0,23) write(*,177) YY,amn,ady,(imm(jd,k),k=0,23) write(*,177) YY,amn,ady,(ihh(jd,k),k=0,23) C write(11,178) YY,amn,ady,(iff(jd,k),ifc(k),k=0,23) write(13,177) YY,amn,ady,(imm(jd,k),k=0,23) write(14,177) YY,amn,ady,(ihh(jd,k),k=0,23) 76 close (unit=12) 77 continue ! go to the next day C End of daily cycle =============== 177 format(3A2,2X,24(I3,2X)) 178 format(3A2,2X,24(I3,A2)) C goto 776 3 write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY ' 776 CLOSE (unit=11) CLOSE (unit=13) CLOSE (unit=14) RETURN END