program convergt C ........................................................Jan. 2014 C File names in statust.txt not including YYMMDD C.........................................................Dec. 2013 C Use data & results in /graf/ C C.........................................................Oct. 2013 C Use fcF2 & hcF2 results of MAPIRIP C C.........................................................Apr. 2012 C Maps in IONEX format C ........................................................Dec. 2011 C Exclude usage of fres, hres from SMI option C ........................................................Dec. 2009 C Construct *.br file = (preceding month + current month) from \web\ results C C Add TEC calculation adjusted to foF2&hmF2, arrange input of kp-index C C ........................................................Aug. 2009 C Add conj.point restoration with SUBCONP.FOR subroutine........... C C ........................................................Oct. 2008 C Mover med restoration to 14 preceding days C Include: t0=1(0) write(not write) results for thia station/days C Include calculation of period for median in subclone.for C C ........................................................Aug. 2007 C Include file for set of stations.................... C ........................................................Mar. 2007 C Cycle on stations/data C C Combined extraction f,m data from different sources C c [1] Subr "SUBRAL1" EXTRACT HOURLY "FOF2/M3000 " FROM RAL FILES c [2] Subr "SUBSECG" from converted data from SEC files c [3] Subr "SUBDIAS2" from DIAS files or SUBNGDC from NGDC files c [4] Subr "SUBSGO" from SGO files xxxx remove DIMENSION IM(0:12) +,NSUBS(80),GLATS(80),GLONS(80) +,if2(31,0:23),ih2(31,0:23),im3(31,0:23) +,R12y(0:12) REAL rkp(0:366,0:7),prekp(0:7) +,CLATS(80),CLONS(80) ! conj. point coordinates INTEGER*2 JFS(80),JHS(80),JTS(80),NFULF,NFULM,MAXD2 +,id1,id2 CHARACTER(10) DD CHARACTER(10) TT CHARACTER(5) ZZ,resf(0:31,24),resm(0:31,24) CHARACTER*128 outfile1,outfile2 +,outfile3,infile,routfile +,outfile4,infile1,infile3,infile4 CHARACTER*30 STINP(80),STNAME CHARACTER*4 YEARR(80),TTT,YEAR CHARACTER*13 STAT,STATS(80) CHARACTER*1 fmh CHARACTER*2 ST,AMN,DY1,DY2 +,CDAY(0:31),dd1,dd2,YY,DY11,DY22 +,STTT +,STS(80),AMNS(80),DY1S(80),DY2S(80),FULF(80),FULM(80),STCL(80) 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 /BL3/ STATS,STS,GLATS,GLONS,JFS,JHS,II,AMNS,JTS COMMON /BL4/ FULF,FULM,NFULF,NFULM,MAXD2 COMMON /BL5/ APROX,BPROX COMMON /BL6/ CLATS,CLONS COMMON /BL7/ YEARR COMMON /BL8/ IF2,IM3,IH2 COMMON /FIKP/rkp,prekp c- COMMON /CONST1/HUMR,DUMR,FAP,INDAP,AKP,COV,RZS,HMLON DATA IM/31,31,28,31,30,31,30,31,31,30,31,30,31/ CC CC C CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ) TTT(1:4)=TT(1:4) WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TTT WRITE(*,*) 'Check file*******' pause ' ' c C C C Prepare List of full data -stations APROX=2.876820E-02 BPROX=4.601528 nfulf=0 nfulm=0 do i=1,80 fulf(i)='00' fulm(i)='00' enddo C First read status file: infile='statust.txt' ! none YYMMDD at station name C OPEN(10,FILE=INFILE) ii=0 maxd2=0 do 103 ist=1,80 read(10,99) STAT,ST,NSUB,GLAT,GLON,YEAR,AMN,DY1,DY2,JF,JH,JT +,STTT,STNAME,XLAT,XLON ! c.p. lati & longi if ((jf.eq.0).and.(jh.eq.0).and.(jt.eq.0)) then goto 103 endif write(*,99) STAT,ST,NSUB,GLAT,GLON,YEAR,AMN,DY1,DY2,JF,JH,JT +,STTT,STNAME,XLAT,XLON 99 format(1X,A13,A2,1X,I1,2(1X,F5.1),7X,A4,3(1X,A2),3(2X,I1),1X,A2 +,1X,A30,2(1X,F5.1)) ii=ii+1 STATS(II)=STAT STS(II)=ST NSUBS(II)=NSUB GLATS(II)=GLAT GLONS(II)=GLON YEARR(II)=YEAR YY=YEAR(3:4) AMNS(II)=AMN DY1S(II)=DY1 DY2S(II)=DY2 JFS(II)=JF JHS(II)=JH JTS(II)=JT STCL(II)=STTT STINP(II)=STNAME CLATS(II)=XLAT CLONS(II)=XLON C if (jf.gt.0) then nfulf=nfulf+1 fulf(nfulf)=st endif C if (jh.gt.0) then nfulm=nfulm+1 fulm(nfulm)=st endif C YY=YEAR(3:4) if (ii.eq.1) then CALL SUBKPC endif 103 continue close(unit=10) iinum=ii CTemp C Start cycle on stations: do 105 ist=1,II C--- goto 105 ! TEMP STAT=STATS(IST) ST=STS(IST) NSUB=NSUBS(IST) GLAT=GLATS(IST) GLON=GLONS(IST) YEAR=YEARR(IST) YY=YEAR(3:4) AMN=AMNS(IST) DY1=DY1S(IST) DY2=DY2S(IST) JF=JFS(IST) JH=JHS(IST) JT=JTS(IST) STTT=STCL(IST) STNAME=STINP(IST) write(*,*) stat,st,stname 38 WRITE(*,*)'year:',YEAR,' month:',amn,' day1:',dy1,' day2:',dy2 C YY=YEAR(3:4) read(amn,*) rmon mn=int(rmon) read(year,*) ryear iyear=int(ryear) read(yy,*) yr iyr=int(yr) read(dy1,*) d1 id1=int(d1) read(dy2,*) d2 id2=int(d2) c- if ((st.eq.'wk').or.(st.eq.'kk')) goto 159 ! avoid for WK & KK if (id2.gt.maxd2) maxd2=id2 ! select max Day2 of inputs 159 z1=yr/4. jz=int(z1)*4 IF(jz.EQ.iyr) THEN IM(2)=29 ELSE IM(2)=28 ENDIF C Read R12 for current year: open(19,file='R12.dat',status='OLD') 211 read(19,*, end=199) j,(R12y(k),k=1,12) if (j.lt.iyear) then R12y(0)=R12y(12) goto 211 endif R12=R12y(mn) if (R12.gt.150.0) R12=150.0 199 continue close(unit=19) C IDNR=IM(MN) LHR=24*IDNR DD1='01' ! for input file title C Specify DD2 for given month: C dd2='28','29','30','31' ! for input file title C define day of end of month: jd=idnr call blet2(jd,DD2) C outfile1='d:\web\idce\styrf.br' outfile1(13:14)=ST outfile1(15:16)=YY C outiles are different for ,f. and outfile1(17:20)='f.br' C outfile2=outfile1 outfile2(17:20)='t.br' outfile3=outfile1 outfile3(17:20)='m.br' outfile4=outfile3 outfile4(17:20)='h.br' infile1='d:\web\graf\YEAR\styrf.br' c++ if (st.eq.'tk') infile1(10:10)='i' infile1(13:16)=YEAR infile1(18:)=outfile1(13:) infile3=infile1 infile3(18:)=outfile3(13:) infile4=infile1 infile4(18:)=outfile4(13:) C C?? if (st.eq.'wz') goto 108 !++++++++++++++ C select case (nsub) C RAL: case (1) C 1 call subral2t(cday,infile1,infile3,infile4) goto 108 ! output results C SEC: case (2) 2 if (jt.eq.3) then if (DY1.eq.'01') then jt=1 else jt=2 endif endif !SEP 2022 C?? call subsec2a(cday,infile1,infile3,infile4) C else !SEP 2022 C goto 108 !SEP 2022 C endif !SEP 2022 goto 108 ! output results C DIAS: case (3) routfile=outfile1 !ngdc C call subionka2(cday,if2,im3,ih2) ! Novosibirsk call subionka2a(cday,if2,im3,ih2) ! Novosibirsk 3 continue goto 108 ! output results case (4) C SGO: 4 continue kdy1=id1 kdy2=id2 call subsgo2a(kdy1,kdy2,cday,resf,resm) !TEMPPPPPPPPPPPPPPPP C call subsgo2(cday,resf,resm) goto 108 case (5) 5 continue c- call subxml1(cday) ! Dourbes, El Arenosillo,Beijing call subxml1 goto 108 ! output results c case (6) 6 continue c- call subsao(cday) ! Austin, Chung-Li, Sjj, Chinese (5) call subsao1 ! Austin, Chung-Li, Sjj, Chinese (5) goto 108 ! output results C+++++++ end select C output results 108 continue C NEW++++ JT=2 means REMOVE the preceding day line from output files: fmh='t' C call subrecogs(fmh,outfile2) ! TEC call subrecogp(fmh,outfile2) ! TEC if (JF.GT.0) then fmh='f' c== call subremow(fmh,outfile1) ! f.br C call subrecogs2(fmh,outfile1) ! f.br call subrecogp(fmh,outfile1) ! f.br endif if (JH.GT.0) then fmh='m' C call subrecogs(fmh,outfile3) ! m3.br call subrecogp(fmh,outfile3) ! m3.br fmh='h' C call subrecogs(fmh,outfile4) ! hm.br call subrecogp(fmh,outfile4) ! hm.br endif C+++++++++++++++++++++++++++++++++++++++++++++++ c-- OPEN(12,FILE=OUTFILE1,ACCESS='APPEND') c-- if (jh.gt.0) then c-- OPEN(14,FILE=OUTFILE3,ACCESS='APPEND') c-- endif c 702 JFS(IST)=JF JHS(IST)=JH call subdevgx(ist) ! DEVLOG 102 continue crem write(*,98) STAT,ST,NSUB,GLAT,GLON,YEAR,AMN,DY1,DY2,JF,JH,JT crem +,STTT,STNAME c write(19,98) STAT,ST,NSUB,GLAT,GLON,YEAR,AMN,DY1,DY2,JF,JH,JT 98 format(1X,A13,A2,1X,I1,2(1X,F5.1),7X,A4,3(1X,A2) +,1X,'f',I1,1X,'h',I1,1X,'t',I1,1X,A2,1X,A23) c pause' ' 105 continue c close(unit=19) C +++++++++++++++Avoid CLONE for COMPLETE data for given day C 1000 continue C GOTO 2002 ! AVOID CPPPPPPPPPPPPPPP C ++++++++++++ Prepare for c.p. calculations ++++++++++++ DO 2001 ist=1,IINUM stat=stats(ist) st=sts(ist) sttt=stcl(ist) year=yearr(ist) yy=year(3:4) amn=amns(ist) read(amn,*) mn dy11=dy1s(ist) dy22=dy2s(ist) read(dy11,*) d1 ! starting day for clone id1=int(d1) read(dy22,*) d2 ! ending day for clone id2=int(d2) C c- if (jfs(ist).eq.0) goto 2001 call subcongs(ist) ! conj.point 2001 continue 2002 pause ' ' STOP END c C***********************************************************