!$$$  MAIN PROGRAM DOCUMENTATION BLOCK
!
! MAIN PROGRAM:  MRGPRF
!   PRGMMR: David W. Behringer  ORG: NP23        DATE: 2003-07-25
!
! ABSTRACT:  Perform quality control on subsurface temperature data
!   for use in Global Ocean Data Assimilation System
!
! PROGRAM HISTORY LOG:
! 2003-07-25  David W. Behringer
! 2004-01-30  David W. Behringer - bug fix in routine merge_files
!
! USAGE:
!   INPUT FILES:
!     UNIT 11  - TEMPERATURE PROFILE DATA IN IEEE
!     UNIT 12  - TEMPERATURE PROFILE DATA IN IEEE
!
!   OUTPUT FILES:
!     UNIT 51  - MERGED TEMPERATURE PROFILE DATA IN IEEE
!     UNIT 06  - UNIT 6 (STANDARD PRINTFILE)
!
!   WORK FILES:  (INCLUDING SCRATCH FILES)
!     None
!
!   SUBPROGRAMS CALLED FROM PROGRAM: (LIST ALL CALLED FROM ANYWHERE IN CODES)
!     UNIQUE:    - merge_files
!     LIBRARY:
!       W3LIB    - w3tagb, w3tage, errexit
!
!   SUBPROGRAMS CALLED FROM MAIN: (LIST ALL CALLED FROM MAIN)
!     UNIQUE:    - merge_files
!     LIBRARY:
!       W3LIB    - w3tagb, w3tage, errexit
!
!   EXIT STATES:
!     COND =   0 - SUCCESSFUL RUN
!     COND =  11 - ERROR OPENING UNIT 11
!     COND =  12 - ERROR READING UNIT 11
!     COND =  21 - ERROR OPENING UNIT 12
!     COND =  22 - ERROR READING UNIT 12
!     COND =  51 - ERROR OPENING UNIT 51
!
! REMARKS AND IMPORTANT LOCAL VARIABLES:
!     None
!
! ATTRIBUTES:  (LIST MACHINES FOR WHICH CODE IS USED AND CHECKED OUT)
!
!   MACHINE:  IBM SP
!   LANGUAGE: F90
!
!
!$$$
!
      program mrgPrf
!
!  mrgPrf merges profile files. It assumes the files are sorted by time.
!
      character csign1*8,sid1*2,dtyp1*2,qkey1*1
      real, allocatable, dimension(:) :: t1, z1
      character csign2*8,sid2*2,dtyp2*2,qkey2*1
      real, allocatable, dimension(:) :: t2, z2
!
      call w3tagb('GODAS_MRGPRF',2003,0164,0164,'NP23')
!
! open profile file
!
      open (11, form='unformatted', status='old', &
                            & access='sequential', err=110)
!
      npmx = 0
      do while (.true.)
        read (11, end=100, err=120) iyear,idate,csign1,sid1, &
                                       &  dtyp1,qkey1,yp,xp,np
        if (np .gt. npmx) npmx = np
      end do
  100 continue
      rewind (11)
!
! open 2nd profile file
!
      open (12, form='unformatted', status='old', &
                            & access='sequential', err=210)
!
      do while (.true.)
        read (12, end=200, err=220) iyear,idate,csign2,sid2, &
                                       &  dtyp2,qkey2,yp,xp,np
        if (np .gt. npmx) npmx = np
      end do
  200 continue
      rewind (12)
!
      allocate(t1(npmx))
      allocate(z1(npmx))
      allocate(t2(npmx))
      allocate(z2(npmx))
!
! open profile file
!
      open (51, form='unformatted', access='sequential', err=510)
      call merge_files(11,12,51)
!
      close (11)
      close (12)
      close (51)
!
      call w3tage('GODAS_MRGPRF')
      call errexit(0)
!
  110 write(6,'(a)') 'Error opening profile file on unit 11'
      call w3tage('GODAS_MRGPRF')
      call errexit(11)
!
  120 write(6,'(a)') 'Error reading profile file on unit 11'
      call w3tage('GODAS_MRGPRF')
      call errexit(12)
!
  210 write(6,'(a)') 'Error opening profile file on unit 12'
      call w3tage('GODAS_MRGPRF')
      call errexit(21)
!
  220 write(6,'(a)') 'Error reading profile file on unit 12'
      call w3tage('GODAS_MRGPRF')
      call errexit(22)
!
  510 write(6,'(a)') 'Error opening profile file on unit 51'
      call w3tage('GODAS_MRGPRF')
      call errexit(51)
!
      contains
!
! -------------------------------------------------------------- 
!
      subroutine merge_files(nu1,nu2,nu3)
!
      integer nu1, nu2, nu3
      integer(kind=8) :: iyd1, iyd2
      integer(kind=8) :: scl=100000000
      logical flg1, flg2
!
      flg1 = .false.
      flg2 = .false.
!
      read (nu1,end=2) iyear1,idate1,csign1,sid1,dtyp1,qkey1,y1,x1, &
                           &  np1,(z1(k),t1(k),k=1,np1)
      iyd1 = iyear1*scl + idate1
      flg1 = .true.

2     read (nu2) iyear2,idate2,csign2,sid2,dtyp2,qkey2,y2,x2, &
                           &  np2,(z2(k),t2(k),k=1,np2)
      iyd2 = iyear2*scl + idate2
      flg2 = .true.
!
      do while (flg1 .or. flg2)
        if (flg1 .and. flg2) then
          if (iyd1 .le. iyd2) then
            write (nu3) iyear1,idate1,csign1,sid1,dtyp1,qkey1,y1,x1, &
                           &  np1,(z1(k),t1(k),k=1,np1)
            read (nu1, iostat=ios) iyear1,idate1,csign1,sid1,dtyp1, &
                           &  qkey1,y1,x1,np1,(z1(k),t1(k),k=1,np1)
            iyd1 = iyear1*scl + idate1
            if (ios .ne. 0) flg1 = .false.
          else
            write (nu3) iyear2,idate2,csign2,sid2,dtyp2,qkey2,y2,x2, &
                           &  np2,(z2(k),t2(k),k=1,np2)
            read (nu2, iostat=ios) iyear2,idate2,csign2,sid2,dtyp2, &
                           &  qkey2,y2,x2,np2,(z2(k),t2(k),k=1,np2)
            iyd2 = iyear2*scl + idate2
            if (ios .ne. 0) flg2 = .false.
          end if
        else if (flg1) then
          write (nu3) iyear1,idate1,csign1,sid1,dtyp1,qkey1,y1,x1, &
                           &  np1,(z1(k),t1(k),k=1,np1)
          read (nu1, iostat=ios) iyear1,idate1,csign1,sid1,dtyp1, &
                           &  qkey1,y1,x1,np1,(z1(k),t1(k),k=1,np1)
          iyd1 = iyear1*scl + idate1
          if (ios .ne. 0) flg1 = .false.
        else if (flg2) then
          write (nu3) iyear2,idate2,csign2,sid2,dtyp2,qkey2,y2,x2, &
                           &  np2,(z2(k),t2(k),k=1,np2)
          read (nu2, iostat=ios) iyear2,idate2,csign2,sid2,dtyp2, &
                           &  qkey2,y2,x2,np2,(z2(k),t2(k),k=1,np2)
          iyd2 = iyear2*scl + idate2
          if (ios .ne. 0) flg2 = .false.
        end if
      end do
!
      rewind (nu1)
      rewind (nu2)
      rewind (nu3)
!
      end subroutine merge_files
!
      end program mrgPrf