C ================================================================= subroutine SUBRAL2tc(CDAY,out1,out3,out4) C ..........................................................Jan. 2012 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 CHARACTER*10 CCM,title,aa CHARACTER*4 YEAR C +,F2,F3 CHARACTER*13 STAT CHARACTER*2 ST,AMN,DY1,DY2,DDD,CDAY(0:31),dd1,dd2,YY +,FULF(80),FULM(80),DY22,CYR,CMN,CDY CHARACTER*30 STNAME C +,fm CHARACTER(10) DD CHARACTER(5) ZZ CHARACTER*128 infile,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 CCM=YEAR CCM(5:5)='-' CCM(6:7)=AMN CCM(8:8)='-' C 1 continue infile='c:\web\graf\20YR\MN\YRMNDYDourbes_iono.txt' infile(13:16)=YEAR infile(18:19)=AMN infile(21:)=STNAME 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') ! 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=INFILE) C CCM(9:10)=DDD ist=0 10 read (111,150,err=3,end=70) title 150 format(A10) C+ 150 format(25X,A10) if (title.eq.ccm) then ist=ist+1 backspace(111) goto 11 else goto 10 endif c 11 continue 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. C F2=' 0' C F3=' 0' c c 280 read (111,160,err=3,end=400) AA,IDY,LTH,LTM,F2M,AM3 280 read (111,160,err=3,end=481) AA,IDY,LTH,LTM,F2M,AM3 160 FORMAT(A8,3(I2,1X),33X,F5.2,7X,F6.3) 290 if (idy.ne.jd) then if (idy.lt.jd) then goto 280 else goto 400 endif endif C if ((f2m.gt.90.).or.(f2m.le.1.0)) f2m=0. if (am3.gt.90.) am3=0. RLT1=LTH+(LTM+5.)/60. ! UT of record LT1=int(rlt1) C ! Missed record for LT --------- 380 if ((LT1.gt.LT).and.(icnt1.eq.0)) then ! Missed record for LT --------- iff(jd,lt)=0 ihh(jd,lt)=0 imm(jd,lt)=0 xf2(lt)=0. xm3(lt)=0. xhm(lt)=0. lt=lt+1 if (lt.gt.23) then goto 76 else backspace(111) goto 280 endif ENDIF ! ------------ C LT1=LT--------------------------------------------------------- : 390 IF (LT1.lt.(LT+1)) THEN ! ========== c== if ((f2m.lt.90.).and.(f2m.gt.0.)) then !! if (f2m.lt.90.) then !! ICNT1=ICNT1+1 SHR1=SHR1+f2m endif !! C if (am3.lt.90.) then !! ICNT2=ICNT2+1 SHR2=SHR2+am3 endif !! goto 280 ENDIF ! ========= 400 if (icnt1.gt.0) then cnt1=float(icnt1) C shr1=shr1*10./cnt1 ! for foF2 if (shr1.lt.10.) shr1=0. backspace(111) else SHR1=0. endif C if (icnt2.gt.0) then cnt2=float(icnt2) shr2=shr2*100./cnt2+.5 ! for M3000 else SHR2=0. endif 480 IFF(JD,lt)=nint(shr1) IMM(JD,lt)=nint(shr2) C---------------------------------------- 481 xf2(lt)=shr1/10. xm3(lt)=shr2/100. xhm(lt)=0. lt=lt+1 630 IF (lt.lt.24) then GOTO 220 else goto 76 endif C C No data for particular day: 70 if (ist.eq.0) then write(*,*) "No data for day:",jd endif 76 close (unit=111) 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(*,177) YY,amn,ddd,(iff(jd,k),k=0,23) write(*,177) YY,amn,ddd,(imm(jd,k),k=0,23) write(*,177) YY,amn,ddd,(ihh(jd,k),k=0,23) C write(11,177) YY,amn,ddd,(iff(jd,k),k=0,23) write(13,177) YY,amn,ddd,(imm(jd,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)) goto 2 3 write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY ' 2 CLOSE (unit=111) CLOSE (unit=11) CLOSE (unit=13) CLOSE (unit=14) RETURN END