c Modified from convert-to-metric.for by TANG, Qiuhong c tangqh@iis.u-tokyo.ac.jp c 2005/9/20 *** PGM CONVERTS DATSAV2 SOD FROM ENGLISH TO METRIC UNITS *** IMPLICIT INTEGER(A-Z) REAL TTAVG,TDDAVG,SLPAVG,STPAVG,VISAVG,SPDAVG,SPDMAX,GSTALL REAL MAXTMP,MINTMP,PCPTOT,SNDPIN CHARACTER*132 HEADER CHARACTER*1 PCPIND,MAXFLG,MINFLG CHARACTER*75 finch,fmeter,outdir,selwmo,allstn integer stnmsc real lon, lat, elev integer stnmsc0,found,stntmp real lon0, lat0, elev0 outdir='./selmet/' Call Strlen(outdir,l1,l2) Imkdir= makedirqq(outdir(l1:l2)) selwmo=outdir(l1:l2)//'selstn.txt' allstn=outdir(l1:l2)//'allstn.txt' open (unit=300, file=selwmo, form='formatted', + access='sequential', status='unknown') open (unit=400, file=allstn, form='formatted', + access='sequential', status='unknown') open (unit=200, file='station_info', form='formatted', + access='sequential', status='old') 444 read(unit=200, fmt=5042, end=5555) stnmsc0,lon0, lat0, elev0 !Use Lat, Lon, Elev from wmo data as the 'reliable' data found=0 open (unit=100, file='station_wmo.txt', form='formatted', + access='sequential', status='old') 222 read(unit=100, fmt=5042, end=3333) stnmsc,lon, lat, elev stntmp=stnmsc0*10 if (stntmp.eq.stnmsc) then write(400,5044) stnmsc0,lon, lat, elev found=1 goto 3333 endif goto 222 3333 close(unit=100) if (found.eq.0) write(400,5044) stnmsc0,lon0, lat0, elev0 goto 444 5555 close(unit=200) open (unit=100, file='station_wmo.txt', form='formatted', + access='sequential', status='old') 888 read(unit=100, fmt=5042, end=9999) stnmsc,lon, lat, elev found=0 open (unit=200, file='station_info', form='formatted', + access='sequential', status='old') 666 read(unit=200, fmt=5042, end=7777) stnmsc0,lon0, lat0, elev0 stnmsc0=stnmsc0*10 if (stnmsc0.eq.stnmsc) then found=1 goto 7777 endif goto 666 7777 close(unit=200) wrall=1 if (found.eq.0) then finch='' fmeter='' write(finch,'(I6.6)') stnmsc finch(7:10)='.txt' fmeter=outdir(l1:l2)//finch call covert(finch,fmeter) write(300,5044) stnmsc,lon, lat, elev write(400,5044) stnmsc,lon, lat, elev endif goto 888 5042 format(I,3f) 5044 format(I,3f15.5) 9999 close(unit=100) close(unit=300) close(unit=400) END subroutine covert(finch,fmeter) IMPLICIT INTEGER(A-Z) REAL TTAVG,TDDAVG,SLPAVG,STPAVG,VISAVG,SPDAVG,SPDMAX,GSTALL REAL MAXTMP,MINTMP,PCPTOT,SNDPIN CHARACTER*132 HEADER CHARACTER*1 PCPIND,MAXFLG,MINFLG CHARACTER*75 finch,fmeter real fe,fes,fes2,frh,frhmin OPEN (11,FILE=finch) OPEN (21,FILE=fmeter) READ (11,810) HEADER 810 FORMAT (A132) c WRITE (21,810) HEADER *** 2 READ (11,800,END=99) STN,YR,MO,DA,TTAVG,TTCNT, - TDDAVG,TDDCNT,SLPAVG,SLPCNT,STPAVG,STPCNT,VISAVG,VISCNT, - SPDAVG,SPDCNT, - SPDMAX,GSTALL,MAXTMP,MAXFLG,MINTMP,MINFLG,PCPTOT,PCPIND, - SNDPIN,FOG,RAIN,SNOW,HAIL,THNDER,TORN 800 FORMAT (I6.6,2X,I4.4,I2.2,I2.2,2X,F6.1,1X,I2,2X,F6.1,1X, - I2,2X,F6.1,1X,I2,2X,F6.1,1X,I2,2X,F5.1,1X,I2,2X, - F5.1,1X,I2, - 2X,F5.1,2X,F5.1,2X,F6.1,A1,1X,F6.1,A1,1X,F5.2,A1,1X, - F5.1,2X,6I1) IF (TTAVG .NE. 9999.9) TTAVG = (TTAVG - 32.) / 1.8 IF (TDDAVG .NE. 9999.9) TDDAVG = (TDDAVG - 32.) / 1.8 IF (VISAVG .NE. 999.9) VISAVG = VISAVG / .6214 IF (SPDAVG .NE. 999.9) SPDAVG = SPDAVG / 1.9425 IF (SPDMAX .NE. 999.9) SPDMAX = SPDMAX / 1.9425 IF (GSTALL .NE. 999.9) GSTALL = GSTALL / 1.9425 IF (MAXTMP .NE. 9999.9) MAXTMP = (MAXTMP - 32.) / 1.8 IF (MINTMP .NE. 9999.9) MINTMP = (MINTMP - 32.) / 1.8 IF (PCPTOT .EQ. 99.99) PCPTOT = 999.9 IF (PCPTOT .NE. 999.9) PCPTOT = PCPTOT * 25.4 IF (SNDPIN .NE. 999.9) SNDPIN = SNDPIN * 2.54 c*********** write as SiB2 DHM format *************** c BY: TANG, Qiuhong (tangqh@iis.u-tokyo.ac.jp) c URL: http://www.srh.noaa.gov/elp/wxcalc/wxcalc.shtml c also see wxcalc2go.zip if (TDDAVG.ne.9999.9.and.TTAVG.ne.9999.9) then fe=6.11*10.0**(7.5*TDDAVG/(237.7+TDDAVG)) fes=6.11*10.0**(7.5*TTAVG/(237.7+TTAVG)) frh=fe/fes*100 Nfrh=NINT(frh) else Nfrh=32766 endif if (TDDAVG.ne.9999.9.and.MAXTMP.ne.9999.9) then fe=6.11*10.0**(7.5*TDDAVG/(237.7+TDDAVG)) fes2=6.11*10.0**(7.5*MAXTMP/(237.7+MAXTMP)) frhmin=fe/fes2*100 Nfrhmin=NINT(frhmin) else Nfrhmin=32766 endif c print *, frh,frhmin,fe,TDDAVG IF (TTAVG.NE.9999.9) THEN NTTAVG=NINT(TTAVG*10) ELSE NTTAVG=32766 ENDIF IF (MAXTMP.NE.9999.9) THEN NMAXTMP=NINT(MAXTMP*10) ELSE NMAXTMP=32766 ENDIF IF (MINTMP.NE.9999.9) THEN NMINTMP=NINT(MINTMP*10) ELSE NMINTMP=32766 ENDIF IF (SPDAVG.NE.999.9) THEN NSPDAVG=NINT(SPDAVG*10) ELSE NSPDAVG=32766 ENDIF IF (SPDMAX.NE.999.9) THEN NSPDMAX=NINT(SPDMAX*10) ELSE NSPDMAX=32766 ENDIF IF (PCPTOT.NE.999.9) THEN NPCPTOT=NINT(PCPTOT*10) ELSE NPCPTOT=32766 ENDIF IF (SNDPIN.NE.999.9) THEN NSNDPIN=NINT(SNDPIN*10) ELSE NSNDPIN=32766 ENDIF c print *,STN,YR,MO,DA,NTTAVG,NMAXTMP, c -NMINTMP,Nfrh,Nfrhmin,32766,32766, c -NSPDAVG,32766,NSPDMAX,NPCPTOT, c -32766,32766,32766,NSNDPIN c pause WRITE (21,901)STN,YR,MO,DA,NTTAVG,NMAXTMP, -NMINTMP,Nfrh,Nfrhmin,32766,32766, -NSPDAVG,32766,NSPDMAX,NPCPTOT, -32766,32766,32766,NSNDPIN 901 FORMAT (19I) c WRITE (21,900) STN,YR,MO,DA,TTAVG,MAXTMP,MINTMP,???(um), c -???(umin),n_summ?,n_lowm?,SPDAVG,fmaxs?,SPDMAX,PCPTOT, c -???d0m,sun?,E01?,SNDPIN c************** write as wmo format ***************** c WRITE (21,900) STN,YR,MO,DA,TTAVG,TTCNT, c - TDDAVG,TDDCNT,SLPAVG,SLPCNT,STPAVG,STPCNT,VISAVG,VISCNT, c - SPDAVG,SPDCNT, c - SPDMAX,GSTALL,MAXTMP,MAXFLG,MINTMP,MINFLG,PCPTOT,PCPIND, c - SNDPIN,FOG,RAIN,SNOW,HAIL,THNDER,TORN c900 FORMAT (I6.6,2X,I4.4,I2.2,I2.2,2X,F6.1,1X,I2,2X,F6.1,1X, c - I2,2X,F6.1,1X,I2,2X,F6.1,1X,I2,2X,F5.1,1X,I2,2X, c - F5.1,1X,I2, c - 2X,F5.1,2X,F5.1,2X,F6.1,A1,1X,F6.1,A1,1X,F5.1,A1,1X, c - F5.1,2X,6I1) GO TO 2 99 END subroutine strlen(str, l1,l2) character str*200 integer i,l1,l2,k k=0 do i = 1, 200 if(k.eq.0 .and. str(i:i).NE.' ') then l1=i k=1 elseif(k.eq.1 .and. str(i:i).EQ.' ') then l2 = i-1 return endif end do l2 = i return end