C ================================================================= subroutine SUBAUS2tc(CDAY,out1,out3,out4) C ..........................................................Apr. 2025 C read Australian f and m annual files C C ............Send results to web/graf/YEAR/styrf.br, styrm.br, styrh.br C DIMENSION IFF(31,0:23),IMM(31,0:23) +,IHH(31,0:23) +,xf2(0:23),xm3(0:23),xhm(0:23) INTEGER*2 NFULF,NFULM,MAXD2,ID1,ID2 C? CHARACTER*10 CCM,title,aa CHARACTER*1 CF1(0:23),CF2(0:23),AF1,AF2,CM1(0:23),CM2(0:23) +,AM1,AM2 CHARACTER*4 YEAR,SCOD c- +,F1,F2,F3 CHARACTER*13 STAT CHARACTER*12 stread CHARACTER*2 ST,AMN,DY1,DY2,DDD,CDAY(0:31),dd1,dd2,YY +,FULF(80),FULM(80),DY22,CYR,CMN,CDY,XX CHARACTER*30 STNAME C +,fm CHARACTER(10) DD CHARACTER(5) ZZ,PARF(0:23),PARM(0:23),XF,XM CHARACTER*128 infilef,infilem,out1,out3,out4,txt ! outfiles graf/YEAR/styrf. m., h.br COMMON /BL1/ST,YEAR,YY,AMN,DY1,DY2,DD1,DD2,ID1,ID2,JF,JH,JT,DY22 +,STNAME COMMON /BL2/ STAT,GLAT,GLON,DD,TTT,ZZ,R12 COMMON /BL4/ FULF,FULM,NFULF,NFULM,MAXD2 c- CCM=YEAR c- CCM(5:5)='-' c- CCM(6:7)=AMN c- CCM(8:8)='-' read(AMN,*) rmn jmn=int(rmn) do k=0,23 CF1(k)=' ' CF2(k)=' ' enddo C 1 continue C infilef='c:\web\graf\20YR\MN\YRMNDYDourbes_iono.txt' infilef='c:\web\graf\20YR\YEARfDourbes_iono.txt' infilem='c:\web\graf\20YR\YEARmDourbes_iono.txt' infilef(13:16)=YEAR infilef(18:21)=YEAR infilem(13:16)=YEAR infilem(18:21)=YEAR infilef(23:)=STNAME infilem(23:)=STNAME C 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') ! kfulf=0 kfulm=0 DO 77 JD=id1,id2 ! day-to-day cycle c- OPEN(111,FILE=INFILE) C define day for comparison: call blet2(jd,DDD) CDAY(JD)=DDD OPEN(111,FILE=INFILEF,action='READ') OPEN(112,FILE=INFILEM,action='READ') 333 format(A4,3A2,2I2,A128) 334 FORMAT(A4,3A2,2I2,24(A1,I3,A1)) 335 FORMAT(A4,3A2,2I2,24(1X,I3,1X)) C C ----------------------------------------------- LT=0 ! Start hour-to-hour cycle 220 IFL=0 ICNT1=0 ! count for foF2 data within [LT1,LT1+1] ICNT2=0 ! count for M3000 data within [LT1,LT1+1] SHR1=0. SHR2=0. DO j=0,23 iff(jd,j)=0 ihh(jd,j)=0 imm(jd,j)=0 ENDDO c c 280 read (111,160,err=3,end=400) AA,IDY,LTH,LTM,F2M,AM3 C 280 read (111,*,err=3,end=481) stread,(PARF(k),k=0,23) SCOD=stread(1:4) XX=stread(5:6) CYR=stread(7:8) CMN=stread(9:10) CDY=stread(11:12) read(CDY,*) rdy idy=int(rdy) read(cmn,*) rmn kmn=int(rmn) if (kmn.lt.jmn) goto 280 C 280 read (111,335,ADVANCE='NO',err=3,end=481) SCOD,XX,CYR,CMN,IDY C- 280 read (111,*,err=3,end=481) SCOD,XX,CYR,CMN,IDY C- +,(CF1(k),IFF(jd,k),CF2(k),k=0,23) 290 if (idy.ne.jd) then goto 280 else do k=0,23 XF=PARF(k) call readpar(XF,iread,AF1,AF2) CF1(k)=AF1 CF2(k)=AF2 IFF(jd,k)=iread enddo goto 400 endif C 400 read (112,*,err=3,end=482) stread,(PARM(k),k=0,23) SCOD=stread(1:4) XX=stread(5:6) CYR=stread(7:8) CMN=stread(9:10) CDY=stread(11:12) read(CDY,*) rdy idy=int(rdy) read(cmn,*) rmn kmn=int(rmn) if (kmn.lt.jmn) goto 400 C- read (112,334,err=3,end=482) SCOD,XX,CYR,CMN,IDY,LTH C- +,(CM1(k),IMM(jd,k),CM2(k),k=0,23) if (idy.ne.jd) then goto 400 else do k=0,23 XM=PARM(k) call readpar(XM,ireadm,AM1,AM2) CM1(k)=AM1 CM2(k)=AM2 IMM(jd,k)=ireadm enddo goto 401 endif C---------------------------------------- 401 DO lt=0,23 xf2(lt)=IFF(jd,lt)/10.0 xm3(lt)=IMM(jd,LT)/100.0 xhm(lt)=0. ENDDO C C check full sets of foF2, M3F2 at DAY2: CTemp if (jd.eq.maxd2) then cntf=0 cntm=0 do n=0,23 if (IFF(JD,n).gt.0) cntf=cntf+1 if (IMM(JD,n).gt.0) cntm=cntm+1 enddo if (cntf.eq.24) then kfulf=kfulf+1 endif if (cntm.eq.24) then kfulm=kfulm+1 endif CTemp endif C Add hmF2 calculation if (cntm.gt.0) then xlat=glat xlon=glon c- xdip=dip call subhmf2(xlat,xlon,jd,xf2,xm3,xhm) glat=xlat glon=xlon c- dip=xdip do k=0,23 if (iff(jd,k).eq.0) then xhm(k)=0.0 imm(jd,k)=0 endif ihh(jd,k)=nint(xhm(k)) enddo endif C Write results in web\graf\YEAR\ outfiles: write(*,178) YY,amn,ddd,(iff(jd,k),CF1(k),CF2(k),k=0,23) write(*,178) YY,amn,ddd,(imm(jd,k),CM1(k),CM2(k),k=0,23) write(*,177) YY,amn,ddd,(ihh(jd,k),k=0,23) C write(11,178) YY,amn,ddd,(iff(jd,k),CF1(k),CF2(k),k=0,23) write(13,178) YY,amn,ddd,(imm(jd,k),CM1(k),CM2(k),k=0,23) write(14,177) YY,amn,ddd,(ihh(jd,k),k=0,23) 77 enddo ! go to the next day C End of daily cycle =============== 177 format(3A2,2X,24(I3,2X)) 178 format(3A2,2X,24(I3,2A1)) c goto 2 3 write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY ' 481 CLOSE (unit=111) 482 CLOSE (unit=112) CLOSE (unit=11) CLOSE (unit=13) CLOSE (unit=14) RETURN END