source: branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/TOOLS/OBSTOOLS/src/convmerge.F90 @ 5712

MODULE convmerge

   USE toolspar_kind
   USE obs_fbm
   USE obs_utils
   IMPLICIT NONE

CONTAINS

   SUBROUTINE conv_fbmerge( cdoutfile, nfiles, fbdata )
      !!---------------------------------------------------------------------
      !!
      !!                     ** ROUTINE conv_fbmerg **
      !!
      !!  ** Purpose : Merge all fbfiles into a single fbfile
      !!
      !!  ** Method  : Use of utilities from obs_fbm.
      !!
      !!  ** Action  :
      !!
      !!   Optional :
      !!     namelist = namobs.in    to select the observation range 
      !!
      !!   History :
      !!        ! 2010 (K. Mogensen) Initial version
      !!----------------------------------------------------------------------
      !! * Arguments
      CHARACTER(LEN=*) :: cdoutfile                ! Input file.
      INTEGER :: nfiles                            ! Number of files
      TYPE(obfbdata), dimension(nfiles) :: fbdata  ! Structure to merge
      !! * Local variables
      type(obfbdata) :: fbmerge
      INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
      INTEGER :: nmaxlev
      INTEGER :: ia,ij,ii
      REAL(fbdp), DIMENSION(nfiles) :: djulini, djulend
      CHARACTER(len=8) :: cl_refdate
      INTEGER :: irefdate,iyea,imon,iday,ihou,imin,isec
      ! Namelist variables
      CHARACTER(len=9) :: cdnamefile='namobs.in'
      LOGICAL :: lexists 
      REAL(fbdp) :: dobsini,dobsend
      NAMELIST/namobs/dobsini,dobsend
      
      dobsini = 0.0
      dobsend = 99991231.235959

      INQUIRE(file=cdnamefile, exist=lexists)
      IF (lexists) THEN
         OPEN(10,file=cdnamefile)
         READ(10,namobs)
         WRITE(*,namobs)
         CLOSE(10)
      ENDIF
      !
      ! Count number of data points
      !
      nmaxlev = 1
      ii = 0
      DO ia = 1,nfiles
         IF (lexists) THEN
            cl_refdate=fbdata(ia)%cdjuldref(1:8)
            READ(cl_refdate,'(I8)') irefdate
            CALL ddatetoymdhms( dobsini, iyea, imon, iday, ihou, imin, isec )
            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(ia), &
               &           krefdate = irefdate )
            CALL ddatetoymdhms( dobsend, iyea, imon, iday, ihou, imin, isec )
            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(ia), &
            &           krefdate = irefdate )
            DO ij = 1, fbdata(ia)%nobs
               IF ( ( fbdata(ia)%ptim(ij) >  djulini(ia) ) .AND. &
                  & ( fbdata(ia)%ptim(ij) <= djulend(ia) ) ) THEN
                  ii = ii + 1
                  nmaxlev = MAX(nmaxlev,fbdata(ia)%nlev)
               ENDIF
            ENDDO
         ELSE
            nmaxlev = MAX(nmaxlev,fbdata(ia)%nlev)
            ii = ii + fbdata(ia)%nobs
         ENDIF
      ENDDO
      !
      ! Merge the input structures into the output structure
      !
      ALLOCATE( iset(ii), inum(ii), iindex(ii))
      ii = 0
      DO ia = 1,nfiles
         DO ij = 1, fbdata(ia)%nobs
            IF (lexists) THEN
               IF ( ( fbdata(ia)%ptim(ij) >  djulini(ia) ) .AND. &
                  & ( fbdata(ia)%ptim(ij) <= djulend(ia) ) ) THEN
                  ii = ii + 1
                  iset(ii)   = ia
                  inum(ii)   = ij
                  iindex(ii) = ii
               ENDIF
            ELSE
               ii = ii + 1
               iset(ii)   = ia
               inum(ii)   = ij
               iindex(ii) = ii
            ENDIF
         ENDDO
      ENDDO
      WRITE(*,*)'Output number of observations = ',ii
      WRITE(*,*)'Output number of levels       = ',nmaxlev
      !
      ! Prepare fbmerge structure
      !
      CALL init_obfbdata( fbmerge )
      CALL alloc_obfbdata( fbmerge, fbdata(1)%nvar, ii, nmaxlev, &
         &                 fbdata(1)%nadd, fbdata(1)%next, fbdata(1)%lgrid )
      CALL merge_obfbdata( nfiles, fbdata, fbmerge, iset, inum, iindex )
      !
      ! Write the file
      !
      CALL write_obfbdata( TRIM(cdoutfile), fbmerge )
      !
      ! Dellocate the data
      !
      CALL dealloc_obfbdata( fbmerge )

   END SUBROUTINE conv_fbmerge

#include "ctl_stop.h90"

#include "greg2jul.h90"

!#include "ddatetoymdhms.h90"

END MODULE convmerge