subroutine subngdc2c(stinp) C.....................................................................Aug 2020 C Dixon => Salekhard C extract data NGDC in .dat format C produce result = (Xave(UT-30m)+Xave(ut+30m))/2 C C- DIMENSION im(12) character*128 infile,outfilef,outfileh,txt,m_data +,indate character*3 DDD character*2 AYR,AMN,ADY,st,BYR,CYR,CMN,CDY,ADY1 +,STS_OUT(75),stinp,AMN_pre,XMN ! !Nov 2020 character*4 YEAR,YEAR_pre character*5 STCOD +,NUM_STS(75) !Nov 2020 integer count,f_strings,h_strings dimension ifc(0:23),ihc(0:23) +,fc30(0:23,2),hc30(0:23,2) +,fi(0:23,0:59),hi(0:23,0:59) C DATA STS_OUT/ + 'al','as','ad','au','bb','bc','bp','br' +,'cj','cb','ch','cn','cq','cs','cw','db' +,'dw','er','eg','ei','ff','fz','ga','gg' +,'gr','gu','ha','he','ho','ic','if','jb' +,'jj','jm','jr','kk','kh','ll','lm','mg' +,'ml','mm','mo','mw','nc','nd','ni','ok' +,'pa','pe','pq','rm','ro','sa','sd','sj' +,'sq','tk','tr','tu','tv','vt','wk','wp' +,'yg','mh','mb','di','at','eb','bl','gm' +,'so','ns','yk'/ ! NOV 2022 DATA NUM_STS/ + 'AL945','AS00Q','AS237','AU930','BBJ3R','BC840','BP440','BR52P' +,'CAJ2M','CB53N','RL052','CN53L','09429','CS31K','CW46O','DB049' +,'DW41K','EA653','EG931','EI764','FF051','FZA0M','GA762','GU513' +,'GR13L','GU421','HA419','HE13N','HO54K','IC437','IF843','JB57N' +,'JJ433','JI91J','JR055','TO536','KB548','LL721','LM42B','MG560' +,'ML449','MM168','MA155','MW26P','NI135','ND61R','NI63_','OK426' +,'PA836','PE43K','PQ052','PRJ18','RA041','SAA0K','SD266','SJJ18' +,'SQ67Q','TK356','TR170','TUJ2O','TV51R','VT139','WK546','WI937' +,'YG431','MHJ45','MU12K','DI373','AT138','EB040','BLJ03','GM037' +,'SO166','NV355','YA462'/ !NOV. 2022 C 799 format(A4,2(1X,A2),1X,A4,2(1X,A2),2(1X,I3)) !FEB2015 NEW COMMAND NUMBER = 799 798 format(' YEAR, AMN, DD2 = ',A4,2(1X,A2),1X,A4,2(1X,A2),2(1X,I3)) indate='c:/web/graf/date' ! Tamara C# indate='/var/www/izmiran/ionosphere/weather/graf/date' !!! LIUBA !!FEB2015 open(10,file=indate) !FEB2015 read(10,799) YEAR,AMN,ADY,YEAR_pre,AMN_pre,ADY1,lda2,lda1 !FEB2015 NEW FORMAT NUMBER = 799 WRITE(*,798) YEAR, AMN, ADY,YEAR_pre,AMN_pre,ADY1,lda2,lda1 !FEB2015 NEW FORMAT NUMBER = 798 close(unit=10) AYR=YEAR(3:4) ! infile='c:\web\graf\ngdc\SAA0K_2020DDD.dat' ! Tamara infile(26:27)=AYR ! Tamara read(AYR,*) ryr iyr=int(ryr) read(AMN,*) rmn iMN=int(rmn) c- write(*,*) ' Enter dy1,dy2:' read(ADY1,*) rdy1 idy1=int(rdy1) read(ADY,*) rdy idy2=int(rdy) C outfilef='c:\web\graf\2020\stYRf.br' ! Tamara outfilef(15:16)=AYR ! Tamara outfilef(20:21)=AYR ! Tamara C 30 format(A110) c# UT_Time foF2 hmF2 foF1 hmF1 foE zmE foEs fxI TEC c# Columns 4 5 6 7 8 9 10 11 12 c 2020 050 00:00:00 3.787 189.110 0.000 0.000 0.000 0.000 0.000 0.000 0.944 31 format(3X,A2,1X,I3,2(1X,I2),9X,F6.3,3X,F7.3) C C Select station: DO inum=1,75 !NOV 2022 st=STS_OUT(inum) if (st.eq.stinp) then stcod=NUM_STS(inum) ist=inum exit endif enddo C C Data for station C- DO 51 ist=1,65 infile(18:22)=STCOD ! Tamara outfilef(18:19)=st ! Tamara outfileh=outfilef outfileh(22:22)='h' ! Tamara C+++++++++++++++++++++++++ 333 FORMAT(A128) count=0 OPEN(88,FILE=outfilef) 255 READ(88, 333, END=244) m_data CYR=m_data(1:2) CMN=m_data(3:4) CDY=m_data(5:6) if ((cyr.eq.ayr).and.(cmn.eq.amn_pre).and.(cdy.eq.ady1)) then !2020.07.01 goto 244 else count=count+1 GOTO 255 CONTINUE endif 244 f_strings = count REWIND (88) count=0 do while (count.lt.f_strings) READ(88, 333, END=248) m_data count=count+1 enddo 248 print*,'YES!',st ENDFILE 88 close(UNIT=88) C TLG ADD! CCC count=0 OPEN(55,FILE=outfileh) 355 READ(55, 333, END=344) m_data CYR=m_data(1:2) CMN=m_data(3:4) CDY=m_data(5:6) if ((cyr.eq.ayr).and.(cmn.eq.amn_pre).and.(cdy.eq.ady1)) then ! 2020.07.01 goto 344 else count=count+1 GOTO 355 CONTINUE endif 344 h_strings = count REWIND (55) count=0 do while (count.lt.h_strings) READ(55, 333, END=348) m_data count=count+1 enddo 348 print*,'YES!',st ENDFILE 55 close(UNIT=55) C enddo C=============================================================== OPEN(11,file=outfilef,access='APPEND') OPEN(12,file=outfileh,access='APPEND') do k=0,23 do i=1,2 fc30(k,i)=0. hc30(k,i)=0. enddo enddo f30_pre=0. ! last 30min for prec day h30_pre=0. ! last 30min for prec day C+ DO 41 idy=idy1,idy2 DO 41 lda=lda1,lda2 do it=0,23 do im=0,59 fi(it,im)=0. hi(it,im)=0. enddo enddo if (lda.eq.lda1) then idy=idy1 else idy=idy2 endif C lda=ndoy(iyr,imn,idy) call blet2(idy,ADY) call blet3(lda,DDD) infile(28:30)=DDD ! Tamara C- outfile=infile C- outfile(23:23)='x' C- OPEN(33,file=outfile) C maxut=0 OPEN(10,file=infile,action='READ') 5 read(10,30,end=34) txt k=index(txt,YEAR) ! JAN 2021 if (k.gt.0) then backspace(10) read(10,31,end=34) BYR,ldai,MUT,MIN,fof2,hmf2 fi(mut,min)=foF2 hi(mut,min)=hmF2 if (mut.gt.maxut) maxut=mut C- write(*,30) txt ! Temp else goto 5 endif goto 5 34 close(unit=10) close(unit=33) mutend=mut C do k=0,23 ifc(k)=0 ihc(k)=0 enddo C DO 40 iut=0,23 sum1f=0. sum2f=0. sum1h=0. sum2h=0. icnf1=0 icnh1=0 icnf2=0 icnh2=0 C DO imin=0,29 foF2=fi(iut,imin) hmF2=hi(iut,imin) IF (imin.eq.0) THEN !6 ifc(iut)=nint(foF2*10.) ihc(iut)=nint(hmF2) ENDIF !6 if (fof2.gt.0.) then !8 icnf1=icnf1+1 sum1f=sum1f+fof2 endif !8 if (hmf2.gt.0.) then !9 icnh1=icnh1+1 sum1h=sum1h+hmf2 endif !9 ENDDO C 3 DO imin=30,59 foF2=fi(iut,imin) hmF2=hi(iut,imin) if (fof2.gt.0.) then !11 icnf2=icnf2+1 sum2f=sum2f+fof2 endif !11 if (hmf2.gt.0.) then !12 icnh2=icnh2+1 sum2h=sum2h+hmf2 endif !12 ENDDO c- goto 1 C if (icnf1.gt.0) then !2 fc30(iut,1)=sum1f/icnf1 else !2 fc30(iut,1)=0. endif !2 if (icnf2.gt.0) then !3 fc30(iut,2)=sum2f/icnf2 else !3 fc30(iut,2)=0. endif !3 if (icnh1.gt.0) then !4 hc30(iut,1)=sum1h/icnh1 else !4 hc30(iut,1)=0. endif !4 if (icnh2.gt.0) then !5 hc30(iut,2)=sum2h/icnh2 else !5 hc30(iut,2)=0. endif !5 C 40 CONTINUE ! UT cycle C do iut=0,maxut fut=0. if ((f30_pre.gt.0.).and.(fc30(iut,1).gt.0.)) +fut=(f30_pre+fc30(iut,1))/2. if ((f30_pre.gt.0.).and.(fc30(iut,1).eq.0.)) fut=f30_pre if ((f30_pre.eq.0.).and.(fc30(iut,1).gt.0.)) fut=fc30(iut,1) if (ifc(iut).eq.0) then ifc(iut)=nint(fut*10.) endif hut=0. if ((h30_pre.gt.0.).and.(hc30(iut,1).gt.0.)) +hut=(h30_pre+hc30(iut,1))/2. if ((h30_pre.gt.0.).and.(hc30(iut,1).eq.0.)) hut=h30_pre if ((h30_pre.eq.0.).and.(hc30(iut,1).gt.0.)) hut=hc30(iut,1) if (ihc(iut).eq.0) then ihc(iut)=nint(hut) endif f30_pre=fc30(iut,2) h30_pre=hc30(iut,2) enddo C if (lda.eq.lda1) then ! 2020.07.01 XMN=AMN_pre ! 2020.07.01 else ! 2020.07.01 XMN=AMN ! 2020.07.01 endif ! 2020.07.01 write(*,32) AYR,XMN,ADY,(ifc(k),k=0,23) ! 2020.07.01 write(11,32) AYR,XMN,ADY,(ifc(k),k=0,23) ! 2020.07.01 write(*,32) AYR,XMN,ADY,(ihc(k),k=0,23) ! 2020.07.01 write(12,32) AYR,XMN,ADY,(ihc(k),k=0,23) ! 2020.07.01 32 format(3A2,2X,24(I3,2X)) 41 CONTINUE ! Day-to-day cycle close(unit=11) close(unit=12) 51 CONTINUE Crem pause ' ' C STOP RETURN END C++++++++++++++++++ subroutine subxmld C............................................................Jan. 2019 C +Sopron (xml) C............................................................Nov. 2018 C +Belem C............................................................May 2018 C + Fortaleza FZ C............................................................Sep. 2015 C Dourbes, Beijing .xml file C............................................................June 2013 C Use this subroutine instead of PROGRAM convXML.for C C! Jan 2013 C! Extract foF2, hmF2, M3000 from sao.xml file C! Include subroutines: dayyesr, sublet2 C C TLG......................................................April 2010 C c "CONVNO" EXTRACT foF2 & M3000F2 & hmF2 FROM DAILY-HOURLY FILE, NO C DIMENSION im(12) INTEGER jyr,jmn,jdy,jjut +,jdy_pre,jmn_pre,ID1,ID2 !C! new parameters CHARACTER*128 infile,outfile,TITLE1,TITLE2,m_file,f_file, *h_file CHARACTER*4 YEAR,YEAR_pre CHARACTER*2 AYR,AMN,AMN_pre,ST,DY1,DY2,DDD +,TT,AUT, *CYR,CMN,CDY +,STS_NAME,STS_IN(16),STS_OUT(16) *,dd1,dd2,DY22 CHARACTER*1 fm CHARACTER*12 ursi00,ursi03,ursi92 ! foF2, M3000F2, hmF2 *,xconst,yconst CHARACTER*6 yy6 CHARACTER*5 DAT(0:366,25),FOF2,YREM,YREF,YREH,NUM_STAT(16) CHARACTER*3 DOY CHARACTER*128 m_data CHARACTER*30 STNAME COMMON /BL1/ST,YEAR,AYR,AMN,DY1,DY2,DD1,DD2,ID1,ID2,JF,JH,JT,DY22 +,STNAME DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/ C DATA STS_IN/'AS','JR','EA','DB','GG','EG','EI','NI','PA' DATA STS_IN/'AS','JR','EA','DB','GG','EG','EI','FZ','PA' +,'BP','IF','AL','BL','SP','ER','LL'/ C DATA STS_OUT/'as','jr','ea','db','gg','eg','ei','nc','pa' DATA STS_OUT/'as','jr','ea','db','gg','eg','ei','fz','pa' +,'bp','if','al','bl','sp','er','ll'/ ! bp=Beijing, if=Inl (USA) DATA NUM_STAT/'AS00Q','JR055','EA036','DB049' +,'GU513','EG931','EI764','FZA0M','PA836','BP440','IF843','AL945' +,'BLJ03','SO148','EA653','LL721'/ ! C if (st.eq.'as') RETURN ursi00='URSI ID="00"' ursi03='URSI ID="03"' ursi92='URSI ID="92"' C DAT(0:366,24) do n=0,366 do k=1,25 dat(n,k)=' 00 ' enddo enddo C First foF2 reading: xconst=ursi00 DO i=1,25 dat(0,i)=' 00 ' ENDDO C Next line: get YEAR,AMN,dy2,YEAR_pre,AMN_pre,dy1 from file "date" c datefile='/var/www/izmiran/ionosphere/weather/graf/date' ! Ljuba 50 FORMAT(A4,1x,A2,1x,A2,1x,A4,1x,A2,1x,A2,A10) ! Ljuba c- ist=1 YEAR_pre=YEAR !ADD AMN_pre='01' !temp + C ========================================================== do ist=1,16 if (sts_out(ist).eq.st) exit enddo C Next line: specify YEAR from current date: AYR=YEAR(3:4) C Next line: specify MONTH from current date: read(ayr,*) ryr jyr=int(ryr) read(amn,*) rmn jmn=int(rmn) if(int(ryr/4.)*4.eq.jyr) THEN im(2)=29 ELSE IM(2)=28 ENDIF C!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C! C! Add check content of for preceding month & day: read(dy1,*) rdy1 !C! day in new month jdy=int(rdy1) !C! day in new month ndoy1=0 !C! day in new month read(dy2,*) rdy2 !C! day in new month ndoy1=ndoy(jyr,jmn,jdy) jdy_pre=0 !C! prec. day jmn_pre=0 !C! month for prec. day ndoy0=ndoy1-1 !C! prec. day of year jmn_pre=jmn ! TEMP jdy_pre=jdy ! TEMP call blet2(jmn_pre,AMN_pre) !C! produce CHARACTER AMN_pre call blet2(jdy_pre,dy1) !C! produce CHARACTER C End of Check for preceding day C! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ WRITE(*,*)YEAR,AMN,dy2,YEAR_pre,AMN_pre,dy1 ! this line is moved here C! C Ljuba C=============================================================== C НАчало цикла стирания последних 3-х строк у файлов GM111m.br, IR11m.br YK11m.br NO10m.br c DATA STS_OUT/'GM','IR','NO','YK'/ = GM111m.br IR11m.br YK11m.br NO10m.br C ============================================================== c STS_NAME=st !++ write(*,*) ' STS_NAME=',st c 333 FORMAT(a128) count=0 c m_file='/var/www/izmiran/ionosphere/weather/graf/2014/db14m.br' !Ljuba m_file='c:/web/graf/2014/db14m.br' !Tamara c m_file(42:45)=YEAR !Ljuba c m_file(47:48)=STS_NAME !Ljuba c m_file(49:50)=AYR !Ljuba m_file(13:16)=YEAR !Tamara m_file(18:19)=STS_NAME !Tamara m_file(20:21)=AYR !Tamara OPEN(33,FILE=m_file) 55 READ(33, 333, END=44) m_data CYR=m_data(1:2) CMN=m_data(3:4) CDY=m_data(5:6) yrem=m_data(9:13) if ((cyr.eq.ayr).and.(cmn.eq.amn_pre).and.(cdy.eq.dy1)) then goto 44 else count=count+1 GOTO 55 CONTINUE endif 44 m_strings = count REWIND (33) count=0 do while (count.lt.m_strings) READ(33, 333, END=444) m_data count=count+1 enddo 444 print*,'YES!' ENDFILE 33 close(UNIT=33) CCC count=0 c f_file='/var/www/izmiran/ionosphere/weather/graf/2010/NO10f.br' !Ljuba c f_file(42:45)=YEAR !Ljuba c f_file(47:48)=STS_NAME !Ljuba c f_file(49:50)=AYR !Ljuba f_file='c:/web/graf/2014/db14f.br' !Tamara f_file(13:16)=YEAR !Tamara f_file(18:19)=STS_NAME !Tamara f_file(20:21)=AYR !Tamara OPEN(88,FILE=f_file) 255 READ(88, 333, END=244) m_data CYR=m_data(1:2) CMN=m_data(3:4) CDY=m_data(5:6) yref=m_data(9:13) if ((cyr.eq.ayr).and.(cmn.eq.amn_pre).and.(cdy.eq.dy1)) then goto 244 else count=count+1 GOTO 255 CONTINUE endif 244 f_strings = count REWIND (88) count=0 do while (count.lt.f_strings) READ(88, 333, END=248) m_data count=count+1 enddo 248 print*,'YES!' ENDFILE 88 close(UNIT=88) CCC count=0 c f_file='/var/www/izmiran/ionosphere/weather/graf/2014/db14h.br' !Ljuba c h_file(42:45)=YEAR !Ljuba c h_file(47:48)=STS_NAME !Ljuba c h_file(49:50)=AYR !Ljuba h_file='c:/web/graf/2014/db14h.br' !Tamara h_file(13:16)=YEAR !Tamara h_file(18:19)=STS_NAME !Tamara h_file(20:21)=AYR !Tamara OPEN(55,FILE=h_file) 355 READ(55, 333, END=344) m_data CYR=m_data(1:2) CMN=m_data(3:4) CDY=m_data(5:6) yreh=m_data(9:13) if ((cyr.eq.ayr).and.(cmn.eq.amn_pre).and.(cdy.eq.dy1)) then goto 344 else count=count+1 GOTO 355 CONTINUE endif 344 h_strings = count REWIND (55) count=0 do while (count.lt.h_strings) READ(55, 333, END=348) m_data count=count+1 enddo 348 print*,'YES!' ENDFILE 55 close(UNIT=55) C=============================================================== C Конец цикла стирания последних 3-х строк у файлов C ============================================================== c C=============================================================== C Начало цикла обработки файлов C ============================================================== c c c C Double letters cycle + letters 'f', 'm', 'h': fm='f' iflag=0 C ========================================================== read(dy1,*) rdy1 read(dy2,*) rdy2 idy1=int(rdy1) idy2=int(rdy2) idd=idy1 C STS_NAME=st c+ Next lines = specify path and name of Output file: c= c outfile='/var/www/izmiran/ionosphere/weather/graf/2012/NO12f.br' !Ljuba c outfile(42:45)=YEAR !Ljuba c outfile(47:48)=STS_NAME !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!Ljuba c outfile(49:50)=AYR !Ljuba outfile='c:/web/graf/2012/db12f.br' !Tamara outfile(13:16)=YEAR !Tamara outfile(18:19)=STS_NAME !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!Tamara outfile(20:21)=AYR !Tamara C ========================================================== 101 continue c outfile(51:51)=fm !Ljuba outfile(22:22)=fm !Tamara C ========================================================== OPEN(12,FILE=OUTFILE,ACCESS='APPEND') C ========================================================== 1 do 77 j=idy1,idy2 ! cycle day-by-day jdy=j jj=j-idy1+1 call blet2(jdy,DDD) C C Calculate day-of-year: 17 FORMAT(1X,A3) lday=ndoy(jyr,jmn,jdy) ! function to define day-of-year call blet3(lday,DOY) write(*,17) doy 1111 DO 1110 jut=1,24 ! Daily cycle title1=' ' ut=float(jut-1) jjut=jut-1 call blet2(jjut,AUT) C c STS_NAME=st c print*,'STS_IN=', STS_IN c infile='/var/www/izmiran/ionosphere/weather/graf/DB/' !Ljuba c infile(42:43)=STS_IN(ist) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!Ljuba c infile(45:46)=STS_NAME !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!Ljuba c infile(47:49)=NUM_STAT(ist) !Ljuba c infile(50:)='_2011035040000.SAO' !Ljuba infile='c:/web/graf/DB/' !Tamara infile(13:14)=STS_IN(ist) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!Tamara c infile(16:17)=STS_NAME !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!Tamara infile(16:20)=NUM_STAT(ist) !Tamara C CREM if ((ist.eq.2).or.(ist.eq.4).or.(ist.eq.8).or.(ist.eq.10).or.(ist.eq.11)) then if ((ist.eq.2).or.(ist.eq.8) +.or.(ist.eq.11).or.(ist.eq.13)) then C- if ((ist.eq.2).or.(ist.eq.4).or.(ist.eq.8).or.(ist.eq.10).or. C- +(ist.eq.11)) then infile(21:)='_2011035040000_SAO.XML' !Tamara crem infile(21:)='_2011035040000_SAO.XML' !Ljuba?? else infile(21:)='_2011035040000.SAO.XML' !Tamara crem infile(21:)='_2011035040000.SAO.XML' !Ljuba?? endif if(ist.eq.14) infile(21:)='_2011035040010_SAO.XML' ! SP if(ist.eq.4) infile(21:)='_2011035040002_SAO.XML' ! SP c infile(51:54)=YEAR !Ljuba c infile(55:57)=DOY !Ljuba c infile(58:59)=AUT !Ljuba infile(22:25)=YEAR !Tamara infile(26:28)=DOY !Tamara infile(29:30)=AUT !Tamara c WRITE(*,*)' INFILE:',infile ! ПОТОМ УБРАТЬ КОММЕНТ!!! C ========================================================== OPEN(11,FILE=INFILE) read (11,*,err=2,end=10) title1 goto 9 10 continue TT=title1(1:1) if (TT.eq.' ') then fof2=' 00 ' goto 11 endif 9 continue C Change input for SAO.XML format =============== fof2=' 00 ' C- do k=1,30 144 read (11,333,err=2,end=440) title2 ! extra lines iext=index(title2,xconst) if (iext.gt.0) then backspace(11) goto 151 else goto 144 endif C- enddo 152 format(1X,A12,6X,A6) 151 if (iflag.gt.3) goto 11 ! end for given UT 131 read (11,152,err=2,end=11) yconst,yy6 ! extra lines TLG fof2=' 00 ' if (fm.eq.'m') goto 153 if (fm.eq.'h') goto 154 if((yconst.eq.xconst).and.(fm.eq.'f')) THEN iflag=1 if (yy6(2:2).eq.'.') then fof2(2:2)=yy6(1:1) fof2(3:3)=yy6(3:3) goto 11 else if (yy6(3:3).eq.'.') then fof2(1:2)=yy6(1:2) fof2(3:3)=yy6(4:4) goto 11 endif endif ELSE goto 151 ENDIF 153 if((yconst.eq.xconst).and.(fm.eq.'m')) THEN iflag=2 fof2(1:1)=yy6(1:1) fof2(2:3)=yy6(3:4) goto 11 else goto 151 endif 154 if((yconst.eq.xconst).and.(fm.eq.'h')) THEN iflag=3 fof2(1:3)=yy6(1:3) goto 11 else GOTO 151 endif CCC=================================================== 11 continue dat(jj,jut)=fof2 fof2=' 00 ' 440 CLOSE (unit=11) 107 continue C 1110 continue ! End of daily cycle 77 continue ! end cycle day-to-day c c DO J=1,JJ if (J.eq.1) then DDD=DY1 else DDD=DY2 endif if (fm.eq.'m') then write(12,181) ayr,amn,DDD,(dat(j,k),k=1,24) write(*,181) ayr,amn,DDD,(dat(j,k),k=1,24) do k=1,25 dat(j,k)='000 ' enddo endif if (fm.eq.'f') then write(12,180) ayr,amn,ddd,(dat(j,k),k=1,24) write(*,180) ayr,amn,ddd,(dat(j,k),k=1,24) do k=1,25 dat(j,k)=' 00 ' enddo endif if (fm.eq.'h') then write(12,181) ayr,amn,ddd,(dat(j,k),k=1,24) write(*,181) ayr,amn,ddd,(dat(j,k),k=1,24) do k=1,25 dat(j,k)='000 ' enddo endif 180 format(3A2,2X,24(A5)) 181 format(3A2,2X,24(A5)) ENDDO C c pause ' ' goto 2 3 write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY ' write(*,*) infile goto 202 c pause ' ' C-- goto 1110 2 CLOSE (unit=12) if (fm.eq.'f') then fm='m' xconst=ursi03 goto 101 endif if (fm.eq.'m') then fm='h' xconst=ursi92 goto 101 endif 202 CONTINUE CREM pause ' ' RETURN END c c c C ===============================================================