      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
