source: utils/tools/OBSTOOLS/src/fbcomb.F90 @ 10841

PROGRAM fbcomb
   !!---------------------------------------------------------------------
   !!
   !!                     ** PROGRAM fbcomb **
   !!
   !!  ** Purpose : Combine MPI decomposed feedback files into one file
   !!
   !!  ** Method  : Use of utilities from obs_fbm.
   !!
   !!  ** Action  : 
   !!
   !!   Usage:
   !!     fbcomb.exe outputfile inputfile1 inputfile2 ...
   !!
   !!   History :
   !!        ! 2010 (K. Mogensen) Initial version
   !!----------------------------------------------------------------------
   USE toolspar_kind
   USE obs_fbm
   USE index_sort
   IMPLICIT NONE
   !
   ! Command line arguments for output file and input file
   !
#ifndef NOIARGCPROTO
   INTEGER,EXTERNAL :: iargc
#endif
   INTEGER :: nargs
   CHARACTER(len=256) :: cdoutfile
   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
   !
   ! Input data
   !
   TYPE(obfbdata),POINTER :: obsdata(:)
   INTEGER :: ninfiles,ntotobs,nlev
   !
   ! Time sorting arrays
   !
   REAL(KIND=dp),ALLOCATABLE :: zsort(:,:)
   INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
   INTEGER :: iwmo
   !
   ! Output data
   !
   TYPE(obfbdata) :: obsoutdata
   !
   ! Loop variables
   !
   INTEGER :: ia,iv,ii,ij
   !
   ! Get number of command line arguments
   !
   nargs = IARGC()
   IF ( nargs < 2 ) THEN
      WRITE(*,'(A)')'Usage:'
      WRITE(*,'(A)')'fbcomb outputfile inputfile1 inputfile2 ...'
      CALL abort()
   ENDIF
   CALL getarg( 1, cdoutfile )
   !
   ! Get input data
   !
   ALLOCATE( obsdata( nargs - 1 ) )
   ALLOCATE( cdinfile( nargs - 1 ) )
   ntotobs = 0
   ninfiles = nargs - 1
   DO ia=1, ninfiles
      CALL getarg( ia+1, cdinfile(ia) )
      CALL init_obfbdata( obsdata(ia) )
      CALL read_obfbdata( TRIM(cdinfile(ia)), obsdata(ia) )
      WRITE(*,'(2A)')'File = ', TRIM(cdinfile(ia))
      WRITE(*,'(A,I9,A)')'has', obsdata(ia)%nobs, ' observations'
      ntotobs = ntotobs + obsdata(ia)%nobs
   ENDDO
   WRITE(*,'(A,I8)') 'Total obsfiles : ',ntotobs
   !
   ! Check that the data is confirming
   !
   DO ia=2, ninfiles
      IF ( obsdata(ia)%cdjuldref /= obsdata(1)%cdjuldref ) THEN
         WRITE(*,*)'Different julian date reference. Aborting'
         CALL abort
      ENDIF
      IF ( obsdata(ia)%nvar /= obsdata(1)%nvar ) THEN
         WRITE(*,*)'Different number of variables. Aborting'
         CALL abort
      ENDIF
      IF  (obsdata(ia)%nadd /= obsdata(1)%nadd ) THEN
         WRITE(*,*)'Different number of additional entries. Aborting'
         CALL abort
      ENDIF
      IF ( obsdata(ia)%next /= obsdata(1)%next ) THEN
         WRITE(*,*)'Different number of additional variables. Aborting'
         CALL abort
      ENDIF
      IF ( obsdata(ia)%lgrid .NEQV. obsdata(1)%lgrid ) THEN
         WRITE(*,*)'Inconsistent grid search info. Aborting'
         CALL abort
      ENDIF
      DO iv=1, obsdata(ia)%nvar
         IF ( obsdata(ia)%cname(iv) /= obsdata(1)%cname(iv) ) THEN
            WRITE(*,*)'Variable name ', TRIM(obsdata(ia)%cname(iv)), &
               &      ' is different from ', TRIM(obsdata(1)%cname(iv)), &
               &      '. Aborting'
            CALL abort
         ENDIF
         IF ( obsdata(1)%lgrid ) THEN
            IF ( obsdata(ia)%cgrid(iv) /= obsdata(1)%cgrid(iv) ) THEN
               IF (obsdata(1)%nobs==0) THEN
                  obsdata(1)%cgrid(iv) = obsdata(ia)%cgrid(iv)
               ELSE
                  IF (obsdata(ia)%nobs>0) THEN
                     WRITE(*,*)'Grid name ', TRIM(obsdata(ia)%cgrid(iv)), &
                        &      ' is different from ', &
                        &      TRIM(obsdata(1)%cgrid(iv)), '. Aborting'
                     CALL abort
                  ENDIF
               ENDIF
            ENDIF
         ENDIF
      ENDDO
      DO iv=1,obsdata(ia)%nadd
         IF ( obsdata(ia)%caddname(iv) /= obsdata(1)%caddname(iv) ) THEN
            WRITE(*,*)'Additional name ', TRIM(obsdata(ia)%caddname(iv)), &
               &      ' is different from ', TRIM(obsdata(1)%caddname(iv)), &
               &      '. Aborting'
            CALL abort
         ENDIF
      ENDDO
      DO iv=1,obsdata(ia)%next
         IF ( obsdata(ia)%cextname(iv) /= obsdata(1)%cextname(iv) ) THEN
            WRITE(*,*)'Extra name ', TRIM(obsdata(ia)%cextname(iv)), &
               &      ' is different from ', TRIM(obsdata(1)%cextname(iv)), &
               &      '. Aborting'
            CALL abort
         ENDIF
      ENDDO
   ENDDO
   !
   ! Construct sorting arrays
   !
   ALLOCATE( zsort(5,ntotobs), iset(ntotobs), &
      & inum(ntotobs), iindex(ntotobs))
   ii = 0
   DO ia = 1,ninfiles
      DO ij = 1,obsdata(ia)%nobs
         ii = ii+1
         zsort(1,ii) = obsdata(ia)%ptim(ij)
         zsort(2,ii) = obsdata(ia)%pphi(ij)
         zsort(3,ii) = obsdata(ia)%plam(ij)
         iwmo = TRANSFER( obsdata(ia)%cdwmo(ij)(1:4), iwmo )
         zsort(4,ii) = iwmo
         iwmo = TRANSFER( obsdata(ia)%cdwmo(ij)(5:8), iwmo )
         zsort(5,ii) = iwmo
         iset(ii) = ia
         inum(ii) = ij
      ENDDO
   ENDDO
   !
   ! Get indexes for time sorting.
   !
   CALL index_sort_dp_n(zsort,5,iindex,ntotobs)
   !
   ! Allocate output data
   !   
   nlev = -1
   DO ia = 1,ninfiles
      IF ( obsdata(ia)%nlev > nlev ) nlev = obsdata(ia)%nlev
   ENDDO
   CALL init_obfbdata( obsoutdata )
   CALL alloc_obfbdata( obsoutdata, obsdata(1)%nvar, ntotobs, nlev, &
      &                 obsdata(1)%nadd, obsdata(1)%next, obsdata(1)%lgrid )
   !
   ! Copy input data into output data
   !
   CALL merge_obfbdata( ninfiles, obsdata, obsoutdata, iset, inum, iindex )
   !
   ! Save output data 
   !
   CALL write_obfbdata ( TRIM(cdoutfile), obsoutdata )
   
END PROGRAM fbcomb