program merge_1a c extracts any stations in master file that are in common c with a new data file c then merges extracted data with the new data, checking for c suspect values where both files have data present c then writes to temporary files for checking (master.*) c merge priority is user defined c merge diagnostics are written to a seperate file (fort.99) c parameter (imiss=-9999,maxn=15000) parameter (istart=1701,iend=2000) parameter(err=1.0) character*80 hfmt,dfmt,line character*80 infl01,srcfl01,infl02,srcfl02,outfl,outfl31,outfl32,substr character*20 iname,jname character*13 icountry,jcountry character*9 ilocid,jlocid integer idata(istart:iend,12),icode(istart:iend,12) integer jjdata(istart:iend,12),jjcode(istart:iend,12) integer jdata(12),jcode(12),iwmo(maxn),imatch(maxn) c hfmt='(i7,i6,i7,i5,x,a20,x,a13,x,i4,x,i4,i7,a9)' c hfmt='(i7,i5,i6,i5,a20,a13,2i4,i7,a9)' @@@@@@@@ original format dfmt='(i4,12i5)' c c Set up additional file names write(*,'(''Enter additional .cts file: ''a)') read(*,'(a)')infl01 srcfl01=infl01 isuffix=index(srcfl01,'.cts') srcfl01((isuffix):(isuffix+3))='.src' open(10,file=infl01) open(11,file=srcfl01) c c Set up old master file names write(*,'(''Enter old master .cts file: ''a)') read(*,'(a)')infl02 srcfl02=infl02 isuffix=index(srcfl02,'.cts') srcfl02((isuffix):(isuffix+3))='.src' open(20,file=infl02) open(21,file=srcfl02) c c Set up new master file names write(*,'(''Enter new master .cts file: ''a)') read(*,'(a)')outfl31 outfl32=outfl31 isuffix=index(outfl32,'.cts') outfl32((isuffix):(isuffix+3))='.src' c c call openf(10,'Enter additional data file: ','old',infl01) c call openf(10,'Enter additional data file: ','old',infl01) c write(*,'(''Enter additional source file: '',a80)')infl01 c call openf(11,' ','old',srcfl01) c call openf(20,'Enter master data file: ','old',infl02) c write(*,'(''Enter master source file: '',a80)')infl02 c call openf(21,' ','old',srcfl02) c write(*,*)'Which dataset has priority?' @@@@@ master takes priority for data c write(*,'('' 1: '',a80)')infl01 c write(*,'('' 2: '',a80)')infl02 c read(*,*)pri pri=2 c write(*,*)'Which header info has priority?' @@@@@ master takes priority for header c write(*,'('' 1: '',a80)')infl01 c write(*,'('' 2: '',a80)')infl02 c read(*,*)pri_head pri_head=2 open(31,file=outfl31) open(32,file=outfl32) open(41,file='master.dat.com') open(42,file='master.src.com') c c Read in wmo numbers of new file write(*,'(''Reading '',a80)')infl01 do loop=1,maxn read(10,'(i7,54x,i4,x,i4)',end=19)iwmo(loop),iy1,iy2 do iy=iy1,iy2 read(10,*) enddo enddo write(*,*)'warning: parameter maxn too small for',infl01 19 max_new=loop-1 c c Read and re-write master file, splitting between common and non-common stations write(*,'(''Reading '',a80)')infl02 do loop=1,maxn read(20,hfmt,end=99)jwmo,jlat,jlon,jelv,jname,jcountry,jy1,jy2, & jblock,jlocid read(21,hfmt)jwmo,jlat,jlon,jelv,jname,jcountry,jy1,jy2, & jblock,jlocid iflno=30 do i=1,max_new if(jwmo.eq.iwmo(i))then iflno=40 imatch(i)=1 new=new+1 goto 29 endif enddo 29 continue write(iflno+1,hfmt)jwmo,jlat,jlon,jelv,jname,jcountry,jy1,jy2, & jblock,jlocid write(iflno+2,hfmt)jwmo,jlat,jlon,jelv,jname,jcountry,jy1,jy2, & jblock,jlocid do jy=jy1,jy2 read(20,dfmt)iyear,(jdata(im),im=1,12) write(iflno+1,dfmt)iyear,(jdata(im),im=1,12) read(21,dfmt)iyear,(jcode(im),im=1,12) write(iflno+2,dfmt)iyear,(jcode(im),im=1,12) enddo enddo write(*,*)'Warning: parameter maxn too small for',infl02 99 max_master=loop-1 c c Read new file c Non-common stations are appended to units 31 and 32 c Common stations are merged with unit units 41 and 42 write(*,'(''Re-reading '',a80)')infl01 rewind(10) rewind(11) do loop=1,max_new do iy=istart,iend do im=1,12 idata(iy,im)=imiss icode(iy,im)=imiss enddo enddo read(10,hfmt,end=199)iiwmo,ilat,ilon,ielv,iname,icountry,iy1,iy2, & iblock,ilocid read(11,hfmt)iiwmo,ilat,ilon,ielv,iname,icountry,iiy1,iiy2, & iblock,ilocid if(imatch(loop).ne.1)then write(31,hfmt)iiwmo,ilat,ilon,ielv,iname,icountry,iy1,iy2, & iblock,ilocid write(32,hfmt)iiwmo,ilat,ilon,ielv,iname,icountry,iy1,iy2, & iblock,ilocid endif do iy=iiy1,iiy2 read(10,dfmt)iyear,(idata(iyear,im),im=1,12) read(11,dfmt)iyear,(icode(iyear,im),im=1,12) if(imatch(loop).ne.1)then write(31,dfmt)iyear,(idata(iyear,im),im=1,12) write(32,dfmt)iyear,(icode(iyear,im),im=1,12) endif enddo c If stations are common carry out merge if(imatch(loop).eq.1)then call find(iiwmo) do jy=istart,iend do jm=1,12 jjdata(jy,jm)=imiss jjcode(jy,jm)=imiss enddo enddo read(41,hfmt,end=199)jwmo,jlat,jlon,jelv,jname,jcountry,jy1,jy2, & jblock,jlocid read(42,hfmt)jwmo,jlat,jlon,jelv,jname,jcountry,jy1,jy2, & jblock,jlocid do jy=jy1,jy2 read(41,dfmt)iyear,(jjdata(iyear,im),im=1,12) read(42,dfmt)iyear,(jjcode(iyear,im),im=1,12) enddo ky1=min(jy1,iy1) ky2=max(jy2,iy2) if(pri_head.eq.1)then write(31,hfmt)iiwmo,ilat,ilon,ielv,iname,icountry,ky1,ky2, & iblock,ilocid write(32,hfmt)iiwmo,ilat,ilon,ielv,iname,icountry,ky1,ky2, & iblock,ilocid else write(31,hfmt)jwmo,jlat,jlon,jelv,jname,jcountry,ky1,ky2, & jblock,jlocid write(32,hfmt)jwmo,jlat,jlon,jelv,jname,jcountry,ky1,ky2, & jblock,jlocid endif write(99,hfmt)iiwmo,ilat,ilon,ielv,iname,icountry,ky1,ky2, & iblock,ilocid write(99,hfmt)jwmo,jlat,jlon,jelv,jname,jcountry,jy1,jy2, & jblock,jlocid write(99,*) do ky=ky1,ky2 do km=1,12 if(jjdata(ky,km).ne.imiss.and.idata(ky,km).ne.imiss)then x=real(jjdata(ky,km)) y=real(idata(ky,km)) if(abs(x-y).gt.err)then write(99,'(i4,i3,2i5,2f10.3)')ky,km,idata(ky,km), & jjdata(ky,km),abs(x-y),err endif endif if(pri.eq.1)then if(idata(ky,km).eq.imiss)then idata(ky,km)=jjdata(ky,km) icode(ky,km)=jjcode(ky,km) endif endif if(pri.ne.1)then if(jjdata(ky,km).ne.imiss)then idata(ky,km)=jjdata(ky,km) icode(ky,km)=jjcode(ky,km) endif endif enddo write(31,dfmt)ky,(idata(ky,km),km=1,12) write(32,dfmt)ky,(icode(ky,km),km=1,12) enddo endif enddo 199 continue write(*,'(i6,'' stations in '',a80)')max_new,infl01 write(*,'(i6,'' are new'')')max_new-new write(*,'(i6,'' are old and have been updated'')')new end subroutine find(iiwmo) rewind(41) rewind(42) 1 read(41,'(i7,54x,i4,x,i4)')jwmo,jy1,jy2 if(jwmo.eq.iiwmo)then backspace(41) return endif read(42,*) do jy=jy1,jy2 read(41,*) read(42,*) enddo goto 1 end subroutine openf(iunit,prompt,oldnew,fname) character*(*) prompt,oldnew character fname*80,yes*1 logical fexist 1 write(*,*)prompt write(*,*)'or enter ''XX'' to quit' read(*,'(a\)')fname if(fname(1:2).eq.'XX')stop write(*,*)fname write(*,*) do i=1,75 if(fname(i:i+5).eq.' ')goto 5 enddo 5 continue inquire(file=fname,exist=fexist) if(oldnew.eq.'new')then if(fexist)then write(*,*)'File already exists - open it anyway (y/n)' read(*,'(a1)')yes write(*,*) if(yes.eq.'y')then open(iunit,file=fname,status='old') else goto 1 endif else open(iunit,file=fname,status='new') endif endif if(oldnew.eq.'old')then if(.not.fexist)then write(*,*)'File does not exist - open it anyway (y/n)' read(*,'(a1)')yes write(*,*) if(yes.eq.'y')then open(iunit,file=fname,status='new') else goto 1 endif else open(iunit,file=fname,status='old') endif endif if(oldnew.eq.'unknown')open(iunit,file=fname,status='unknown') end