C /////////////////////////////////////////////////////////////// SUBROUTINE SUBCONGSC(ist) C.........................................................Oct. 2013 C.........................................................Feb. 2012 C C Reconstruction of fcF2, hcF2, TEC at c.p. from maps C C ........................................................Dec 2009 C NOT!!! CALL subfhmed........to produce both foF2 (AARI) & hmF2 (SMI) C C ........................................................Sep 2009 C NOT!!! Add call SUBFMED..........to produce AARI median................ C NOT!!! +input APRZ.DAT, +CCIR.BIN C C NOT!!! First call SUBFMED to produce median for day=15: C (1) for preceding month C (2) for current month C (3) for the next month C Then interpolate between these medians for each given day of current month C C ........................................................Aug 2009 C Enter station number as formal parameter C Use Med and -W_indices of source (isp)_file C to produce cmed and cf2 of c.p. C ........................................................Mar. 2007 C Include transformation of foF2*proxy(1/XHIrad.) !!!!!!!!!!!!! C C Cycle on stations/data C C T.L.Gulyaeva ...........................................Jul. 2009 c Corrected median.(AARI).................................Sep. 2009 C C input file (parent W index data) => C to produce output files (c.p. to be filled) C & (c.p. median of AARI) C & (c.p. W-index) C C Period [id1,id2] not greater than 31 days C ID1 - day of start of array-for-W index C ID2 - day of end of array-for-W index C IDC - day for CLONE (00 for STOP) C C C period from ID1 to ID2 (27 prec. days) for calculation of both and C Crem =============== Medians amd data of foF2 ======================= C DIMENSION XDAT(0:23),xhm(0:23),if2(31,0:23),ih2(31,0:23) +,GLATS(80),GLONS(80),CLATS(80),CLONS(80) INTEGER*2 JFS(80),JHS(80),JTS(80) +,iyr,imn,idy,ipy,ipm,nday,iut integer*4 IRES(0:23) integer*2 ID1,ID2 CHARACTER*2 AYR,AMN,SS(0:23),ADY +,STS(80),DY22,AMNS(80),sta,XMN,XDY,XYR +,DY1,DY2,CMN,CDY,dd1,dd2,YY +,PD,PY,PM,AUT,ST CHARACTER*128 INFILE2 +,INFILE1,XXX,YYY(80),XEND CHARACTER*4 YEAR,CYEAR,CTIME +,TITS(4),TITPAR,TTT CHARACTER*3 VVV CHARACTER*13 STATS(80),STAT CHARACTER*1 fmh,f1 CHARACTER(10) DD CHARACTER(5) ZZ,YYYYY,YDAT(0:23) C C COMMON /BL1/ST,YEAR,AYR,AMN,DY1,DY2,DD1,DD2,ID1,ID2,JF,JH,JT,DY22 +,STNAME COMMON /BL2/ STAT,GLAT,GLON,DD,TTT,ZZ,R12 COMMON /BL3/ STATS,STS,GLATS,GLONS,JFS,JHS,II,AMNS,JTS COMMON /BL5/ APROX,BPROX COMMON /BL6/ CLATS,CLONS DATA TITS/'fcF2','M3F2','hcF2','TEC '/ C cyear=DD(1:4) cmn=DD(5:6) cdy=DD(7:8) ctime=TTT ctime(3:4)='UT' 101 continue C First create .br file for prec. month PM (prec. year PY) + current month AMN (current year YY) read(ayr,*) ryr iyr=int(ryr) read(amn,*) rmn imn=int(rmn) read(DY1,*) rdy idy1=int(rdy) read(DY2,*) rdy2 idy2=int(rdy2) c-- idy=idy1-1 ! last preceding day idy=idy1 call blet2(idy,PD) ipm=imn-1 ipy=iyr C for current JAN if (imn.eq.1) then ipy=ipy-1 ipm=12 endif C call blet2(ipy,PY) call blet2(ipm,PM) C+++++++++++++++++++++++++++++++++++++++++ C C Arrange 3 cycles on fmh='f'for fcF2, 'u' for hcF2, 'p',for TECcp C 103 glat=clats(ist) ! c.p. glon=clons(ist) ! c.p. stat=stats(ist) sta=sts(ist) write(*,*) stat,sta infile1='c:/web/graf/dcp1/yy/STYYPMf.txt' fmh='f' ! 1st run of cycle f1='f' ! for subinter 1 CONTINUE infile1(27:27)=fmh infile1(21:22)=ST if (fmh.eq.'f') then infile1(16:16)='1' TITPAR=TITS(1) endif if (fmh.eq.'u') then infile1(16:16)='6' TITPAR=TITS(3) endif if (fmh.eq.'p') then infile1(16:16)='7' TITPAR=TITS(4) endif infile2=infile1 ! for current month infile2(18:19)=AYR infile2(23:24)=AYR infile2(25:26)=AMN C C Avoid input of prec. month for C j1=0 ! C C++ 304 nday=idy1-1 303 nday=nday+1 if (nday.gt.idy2) goto 332 ! end reading new data C new data: call blet2(nday,ADY) do k=0,23 ydat(k)='000 ' xhm(k)=0. enddo C 17 FORMAT(A128) 199 continue OPEN(21,FILE=infile2) ! reading INFILE2 jcnt=0 do 142 j=1,41 READ (21,17,END=196,ERR=212) XXX if (j.lt.5) then goto 142 ! avoid 4 extra lines endif XYR=XXX(1:2) XMN=XXX(3:4) XDY=XXX(5:6) if ((xyr.eq.AYR).and.(xmn.eq.AMN).and.(xdy.eq.ADY)) goto 196 ! till prec.day j1=j1+1 YYY(j-4)=XXX jcnt=jcnt+1 142 continue 196 close(unit=21) c// jend=jcnt-1 jend=jcnt XEND=XXX 117 FORMAT(A4,1X,A13,1X,'c.p.') 118 FORMAT('Date of issue: ',A4,'.',A2,'.',A2,1X,'Time:',A4) 201 format('YYMMDD|UT 0 1 2 3 4 5 6 7 8' &' 9 10 11 12 13 14 15 16 17 18 19 20' &' 21 22 23'/'-------------------------------------------' &'-------------------------------------------------------------' &'------------------------') OPEN(23,FILE=infile2) ! write here results: for DY1...DY2 write(23,117) TITPAR,stat c// WRITE(23,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TTT write(23,118) CYEAR,CMN,CDY,CTIME write(23,201) C++ do j=1,jend XXX=YYY(j) XMN=XXX(3:4) XDY=XXX(5:6) if ((xmn.eq.amn).and.(xdy.eq.ady)) then goto 207 else write(23,17) YYY(j) endif enddo 207 continue crem close(unit=23) C C Reconstruction of missed data 317 FORMAT(3I2,2X,24(A5)) 300 CONTINUE C c+++++++++++++++++++++ 305 continue iflag=0 do 301 iut=0,23 ! Cycle on UT ===================== YYYYY=ydat(iut) VVV=YYYYY(1:3) YY=YYYYY(4:5) SS(iut)=YY if (vvv(1:1).eq.' ') vvv(1:1)='0' if (vvv(2:2).eq.' ') vvv(2:2)='0' if (vvv(3:3).eq.' ') vvv(3:3)='0' read(vvv,*) rrr xdat(iut)=rrr C C Reconstruction from map: if (rrr.eq.0.) then call blet2(iut,AUT) C C call subinterj(f1,ayr,amn,ady,aut,resm) ! /graf/dfc/YY/MM/ut/... call subinter1(f1,ayr,amn,ady,aut,resm) ! /web/dfs/YY/MM/... xdat(iut)=resm yy(1:1)='/' if (fmh.ne.'p') SS(iut)=YY endif C 327 CONTINUE 301 continue ! End cycle on UT C 310 format(3A2,2X,24(I3,A2)) 311 format(3A2,1X,24(I4,1X)) C Record results for the day: 335 do kk=0,23 ires(kk)=nint(xdat(kk)) if (fmh.eq.'f') if2(nday,kk)=ires(kk) c// if (fmh.eq.'m') im3(nday,kk)=ires(kk) if (fmh.eq.'u') ih2(nday,kk)=ires(kk) enddo if (fmh.eq.'p') then crem write(*,311) ayr,amn,ady,(ires(k),k=0,23) c// write(22,311) ayr,amn,cdy,(ires(k),k=0,23) write(23,311) ayr,amn,ady,(ires(k),k=0,23) else crem write(*,310) ayr,amn,ady,(ires(k),ss(k),k=0,23) c// write(22,310) ayr,amn,cdy,(ires(k),ss(k),k=0,23) write(23,310) ayr,amn,ady,(ires(k),ss(k),k=0,23) endif close(unit=23) GOTO 303 ! next day c== 302 if (fmh.ne.'t') close(unit=11) 302 close(unit=11) goto 210 C 211 write(*,*) 'No input datafile:',infile1 pause ' ' goto 210 212 write(*,*) 'No input datafile:',infile2 pause ' ' 210 CONTINUE c// close(unit=22) 332 if (fmh.eq.'p') goto 223 ! end of calculation if (fmh.eq.'f') then fmh='u' f1='h' goto 1 else if (fmh.eq.'u') then fmh='p' f1='t' goto 1 endif endif C 223 write(*,331) stat 331 format(1X,A13) crem pause ' ' RETURN END