c ==================================================================== c c CSV to binary converter for AMeDAS data c debug for decimal error on tmp. and iso. Sato 02/11/15 c Sato 02/10/13 c compile >> f90 -assume:byterecl csv2bin.for c ==================================================================== c c general parameters character*2 amon character*4 ayr character*5 astn character*11 aname c !hourly values character*2 aday,ahour,awd,aws character*3 aprec,asun,asnow character*5 atemp ! integer iday,ihour integer iprec(24,31),isnow(24,31) integer*1 iwd(24,31),iws(24,31) real temp(24,31),sun(24,31) c !daily values character*1 adpf,adwf,adtf,adsf character*2 adday,adwmax,adwd character*3 adpmax character*4 adprec,adws,adsun character*5 adtemp,adtmax,adtmin c integer idprec(31),iadpmax(31),iadwf(31),iadwd(31) integer iadpf(31),iadsf(31),idwmax(31),iadtf(31) real dws(31),dtemp(31),dtmax(31),dtmin(31),dsun(31) c !output values integer*2 id1(4,24,31) ! 1;prec, 2;wind, 3;sun, 4;temp integer*2 id2(17,31),ierr,isize,isort,iyr2,mon,iiday,iwdws integer*4 inum c real tmp c temporally parameters nday=30 mon=09 iyr=2000 ierr=32767 isort=4 isize=256 irec=1 c c ==================================================================== c c --end of declaration c preset ============================================================= c write(amon,"(I2.2)")mon write(ayr ,"(I4.4)")iyr open(21,file='idx'//ayr//amon//'.csv',status='old') read(21,*) !skip header read(21,*) !skip header open(91,file='idx'//ayr//amon//'.bin',status='unknown') c c MAIN LOOP do id=1,10000 read(21,"(i5,22x,a11,36x,i2,1x,f4.1,1x,i3,1x,f4.1,1x,i4)", & iostat=io) istn,aname,lat1,alat2,lon1,alon2,ialt if(io.lt.0)stop lon2=alon2*10 lat2=alat2*10 write(91,"(i5,14x,A11,7x,i2.2,i3.3,i3.3,i3.3,i4)") & istn,aname,lat1,lat2,lon1,lon2,ialt write(astn,"(I5.5)")istn c HOURLY DATA ======================================================== c open(10,file='h'//astn//'_'//ayr//amon//'.csv',iostat=io, & status='old') if(io.gt.0)cycle c do i=1,4 ! headers of "h?????_YYYYMM.csv" read(10,*) enddo c do i=1,24*nday read(10,"(2(A2,1X),A3,1X,A2,1X,A2,1X,A5,1X,A3,1X,A3)",iostat=io) & aday,ahour,aprec,awd,aws,atemp,asun,asnow if(io.lt.0) exit call c2i(aday,iday,"(i2)") call c2i(ahour,ihour,"(i2)") call c2i(awd,iwd(ihour,iday),"(i2)") call c2i(aws,iws(ihour,iday),"(i2)") call c2i(aprec,iprec(ihour,iday),"(i3)") call c2f(asun,sun(ihour,iday),"(f3.1)") call c2f(atemp,temp(ihour,iday),"(f5.1)") call c2i(asnow,isnow(ihour,iday),"(i3)") c c - As noted in manual, but wrong for this conversion c iwdws=iwd(ihour,iday)*256 + iws(ihour,iday) iwdws=iws(ihour,iday)*256 + iwd(ihour,iday) id1(1,ihour,iday)=iprec(ihour,iday) id1(2,ihour,iday)=iwdws tmp=sun(ihour,iday)*10. id1(3,ihour,iday)=nint(tmp) tmp=temp(ihour,iday)*10. id1(4,ihour,iday)=nint(tmp) enddo !!end of read & end of convert c c end of HOURLY DATA ================================================= c c ###================================================================= c c DAYLY DATA ======================================================== c open(11,file='d'//astn//'_'//ayr//amon//'.csv',status='old', & iostat=io) if(io.gt.0)cycle c do i=1,5 ! headers of "d?????_YYYYMM.csv" read(11,*) enddo c do i=1,nday read(11,"(A2,1X,A4,1X,A1,1X,A3,3X,A4,1X,A1,1X,A2,3X,A2,3X,A5,1X, & A1,1X,A5,3X,A5,3X,A4,1X,A1 )",iostat=io) & adday,adprec,adpf,adpmax,adws,adwf,adwmax,adwd,adtemp, & adtf,adtmax,adtmin,adsun,adsf if(io.lt.0) exit call c2i(adday,iday,"(i2)") call c2i(adprec,idprec(iday),"(i4)") call c2i(adpf,iadpf(iday),"(i2)") call c2i(adpmax,iadpmax(iday),"(i3)") call c2f(adws,dws(iday),"(f4.1)") call c2i(adwf,iadwf(iday),"(i2)") call c2i(adwmax,idwmax(iday),"(i2)") call c2i(adwd,iadwd(iday),"(i2)") call c2f(adtemp,dtemp(iday),"(f5.1)") call c2i(adtf,iadtf(iday),"(i2)") call c2f(adtmax,dtmax(iday),"(f5.1)") call c2f(adtmin,dtmin(iday),"(f5.1)") call c2f(adsun,dsun(iday),"(f4.1)") call c2i(adsf,iadsf(iday),"(i2)") c id2(1,iday)=idprec(iday) id2(2,iday)=iadpf(iday) id2(3,iday)=iadpmax(iday) id2(4,iday)=32767 tmp=dws(iday)*10. id2(5,iday)=nint(tmp) id2(6,iday)=iadwf(iday) id2(7,iday)=idwmax(iday) id2(8,iday)=32767 id2(9,iday)=iadwd(iday) tmp=dtemp(iday)*10. id2(10,iday)=nint(tmp) id2(11,iday)=iadtf(iday) tmp=dtmax(iday)*10. id2(12,iday)=nint(tmp) id2(13,iday)=32767 tmp=dtmin(iday)*10. id2(14,iday)=nint(tmp) id2(15,iday)=32767 tmp=dsun(iday)*10. id2(16,iday)=nint(tmp) id2(17,iday)=iadsf(iday) enddo c end of DAYLY DATA ================================================== c c ###================================================================= c c output binary data ------------------------------------------------- c open(90,file=ayr//amon//'.bin',status='unknown', & access='direct',recl=256) do k=1,nday iiday=k inum=istn iyr2=mod(iyr,100) write(90,rec=irec)isize,inum,isort,iyr2,mon,iiday, & ((id1(i,j,k),i=1,4),j=1,24),(id2(i,k),i=1,17), & (ierr,i=1,8) irec=irec+1 enddo c close(10) close(11) c ###================================================================= c c end of writing ----------------------------------------------------- c write(6,"(' record=',i5,' ID=',A5,5x,A11)")irec,astn,aname enddo !end of station loop stop end c c c c ======================================================= subroutine c2i(data,iwork,fmt) character(*) data character(*) fmt integer iwork if(data(1:1).eq."/")then iwork=32767 return endif read(data,fmt)iwork return end subroutine c2f(data,work,fmt) character(*) data character(*) fmt real work if(data(1:1).eq."/")then work=3276.7 return endif read(data,fmt)work return end c c