program cntdf6c C..............................................................May 2018 C C..............................................................Oct. 2014 C add cycle on 80 stations c c count D+, D- hours per month from .dis file C Input: (1) styrmnc.dis C (2) styrmn.mpr C Output:(1) dist_sta.txt C (2) distyear.cnt DIMENSION IM(12),JCNH(12) INTEGER*4 JHRS(100),NEGPOS(100),NP,IDUR CHARACTER*128 INFILE1,INFILE2,OUTFILE1,OUTFILE2 CHARACTER*21 DIST(100),XXXX CHARACTER*3 TI(12),ti1,stat(80),sta CHARACTER*2 st(80),stcode,yy CHARACTER*5 YEARC CHARACTER*4 AYMN,YEAR CHARACTER*8 TIY(12),satqy,satdy,ti1y DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/ DATA TI/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG' +,'SEP','OCT','NOV','DEC'/ DATA STAT/ + 'alp','ace','ate','aus','bou','bej','bri','cab','slo','gra' +,'cho','jab','boa','caw','dou','nic','dar','tor','egl','eil' +,'fai','gak','gum','dix','bah','guz','han','hes','hob','inl' +,'jej','jic','jul','klg','kha','kok','ler','gim','mgd','maz' +,'mur','mos','maq','maw','tuc','niu','nfk','now','oki','par' +,'per','pru','sas','ram','rom','ros','sal','sod','tom','tso' +,'tow','vit','wak','wal','war','ftz','yam','ich','ash','cam' +,'bel','qan','mil','caj','sop','ear','lul','ela','pok','wke'/ DATA ST/ + 'al','as','at','au','bc','bp','br','cb','ch','gr' +,'cq','jb','bj','cw','db','nc','dw','eb','eg','ei' +,'ff','ga','gg','di','bb','gu','ha','he','ho','if' +,'jj','jm','jr','kg','kh','kk','lm','gm','mg','ml' +,'mm','mo','mq','mw','tu','nd','ni','ns','ok','pa' +,'pe','pq','sa','rm','ro','rv','sd','so','tk','tr' +,'tv','vt','wk','wp','wz','fz','yg','ic','ad','cn' +,'bl','qn','mh','cj','sp','er','ll','ea','pf','wa'/ !Jun.2024 C Test year='2026' yy=year(3:4) outfile1='c:\web\dat5\dist_' infile1='c:\web\tempdis\' infile2='c:\web\tempmpr\' infile1(18:21)='dis\' infile2(18:21)='mpr\' C WRITE(*,*)' ENTER yrmn (0000=stop):' READ(*,15) AYMN YY=AYMN(1:2) Ctemp AYMN='0912' ! Temp 15 FORMAT(A4) c-- if (aymn.eq.'0000') goto 2 ! Stop program YEARC='20 ' YEARC(3:4)=AYMN(1:2) do i=1,12 ti1y=yearc ti1y(6:8)=ti(i) tiy(i)=ti1y enddo outfile2='Dist' outfile2(5:6)=yy outfile2(7:)='ir.cnt' OPEN(112,FILE=OUTFILE2,ACCESS='APPEND') 200 continue c-- WRITE(*,*)' ENTER STATION-CODE OF INPUT FILE :' c-- READ(*,199) stcode 199 format(A2) do 300 jsta=1,80 Ctemp do 300 jsta=81,81 stcode=st(jsta) c-- if (stcode.eq.st(i)) then c-- jsta=i c-- exit c-- endif c-- enddo ieof=0 sta=stat(jsta) write(*,*) sta OUTFILE1(18:20)=stat(jsta) OUTFILE1(21:)='.txt' OPEN(113,FILE=OUTFILE1,ACCESS='APPEND') c infile1(24:26)=sta c infile1(27:)='.txt' c infile1(27:)=sta c DO I=1,128 c IF(INFILE1(I:I).EQ.'.') THEN c J=I c EXIT c ENDIF c ENDDO c C 201 continue INFILE1(22:23)=stcode INFILE2(22:23)=stcode infile1(16:17)=YY infile2(16:17)=YY INFILE1(24:27)=AYMN INFILE2(24:27)=AYMN INFILE1(28:)='c.dis' INFILE2(28:)='.mpr' OPEN(110,FILE=INFILE1) ! file .dis OPEN(111,FILE=INFILE2) ! file .mpr read(aymn,*) iymn iy=IYMN/100 mn=IYMN-iy*100 yr=float(iy) z1=yr/4. jz=int(z1)*4 IF(jz.EQ.iy) THEN IM(2)=29 dnr=366. ELSE IM(2)=28 dnr=365. ENDIF 155 MNHRS=24*IM(MN) c196 FDI$="D:\UDATA\"+YR$+"\"+ST$+YR$+".dis" c201 FDC$="c:\UDATA\"+YR$+"\"+ST$+YR$+".MPR" c210 PRINT FDI$,FDC$,FR$: INPUT TTT 220 L=0 JFL=0 JCMN=0 230 DO I=1,12 JCNH(I)=24*IM(I) ENDDO C 255 JCNH(1)=MNHRS C 260 OPEN "I",1,FDC$ C Read : imon=0 10 read (111,160,err=270,end=3) satqy ! file .mpr 160 format(1X,A8) do 260 i=1,12 if (satqy.eq.tiy(mn)) then imon=1 goto 280 endif 260 continue 270 if (imon.eq.0) goto 10 280 ihrs=0 idays=0 sdmon=0. chmon=0. C Input: number of daily missed hrs=>idis; daily standard deviation=>dsd : do k=1,im(mn) read(111,170,err=177,end=177) idis,dsd ! file mpr 170 format(16X,I2,1X,F6.2) idays=idays+1 ihrs=ihrs+idis hrd=24.0-float(idis) chmon=chmon+hrd sdmon=sdmon+dsd*dsd*hrd enddo C itot = total number of observed hourly foF2 per month: C itot=JCNH(mn)-ihrs 177 itot=24*idays-ihrs C monthly standard deviation: sdm=sqrt(sdmon/chmon) C405 PRINT "mn=";mn,"cmn:";itot C read file : iline=0 idis=0 imn1=mn+1 if (imn1.gt.12) imn1=1 ti1=ti(imn1) 20 read (110,160,err=370,end=371) satdy ! file .dis do 360 i=1,12 if (satdy.eq.tiy(mn)) then iline=1 goto 380 endif 360 continue 370 if (iline.eq.0) then goto 20 else goto 380 endif 371 ieof=1 goto 801 C 380 JCNEG=0 JCPOS=0 C read Dsturbed periods: do k=1,76 read(110,161,err=660,end=659) NP,XXXX,IDUR ! file .dis 161 format(1X,I4,A21,I4) negpos(k)=np dist(k)=xxxx JHRS(k)=idur ! remember .dis line c read(110,180,err=660,end=659) iper,satq,idur c 180 format(1X,I4,1X,A3,18X,I3) c if (satq.eq.ti1) goto 660 if (np.eq.0) goto 659 ! end of dist. periods kk=k if (np.lt.0) then jcneg=jcneg+idur else jcpos=jcpos+idur endif enddo goto 660 C Flag end-of-file: 659 ieof=1 660 jcnt=jcneg+jcpos close(unit=110) C OPEN(113,FILE=OUTFILE1,access='append') cnt=float(jcnt) tot=float(itot) jcneg=-jcneg cneg=float(jcneg) cpos=float(jcpos) per=cnt/tot*100. jper=int(per+.5) pneg=cneg/tot*100. ppos=cpos/tot*100. c PRINT I,R1$(I),"cneg=";CNEG,"cpos=";CPOS : INPUT TT c670 IF CNEG=0 AND CPOS=0 GOTO 580 c810 PRINT "ind=";IND; "hrs=";HRS,"cneg=";CNEG,"cpos=";CPOS iyyyy=2000+iy sdm1=sdm/10. 865 WRITE(113,810) ti(mn),iyyyy,mn,jper,jcnt,itot,sdm1 810 format(A3/I4,2X,I2,1X,I3,1X,I4,1X,I4,1X,F6.2) C append dist periods: do k=1,kk write(113,161) negpos(k),dist(k),JHRS(k) ! .dis line enddo C WRITE(112,800) outfile1,ti(mn),iyyyy,mn,per,jcnt,itot,sdm &,jcneg,pneg,jcpos,ppos WRITE(*,800) infile1,ti(mn),iyyyy,mn,per,jcnt,itot,sdm &,jcneg,pneg,jcpos,ppos 800 format(A35/1X,A3/I4,2X,I2,1X,F5.1,1X,I4,1X,I4,1X,F6.2 *,1X,I4,1X,F7.2,1X,I4,1X,F7.2) c pause ' ' 801 close(unit=111) close(unit=113) if (ieof.eq.0) then goto 201 else goto 2 endif c880 PERN=INT(INEG(J)/CNH(J)*1000+.5)/10 c890 PERP=INT(IPOS(J)/CNH(J)*1000+.5)/10 c900 PRINT R1$(J);R2$(J),CNH(J);PERN;PERP c910 WRITE#2,R1$(J),R2$(J),CNH(J),PERN,PERP 3 write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY ' 2 continue 300 CONTINUE close(unit=112) pause ' ' STOP end