PROGRAM MERGE_VARBC
!-----------------------------------------------------------------------
!   MERGE_VARBC - Merge entries from two VARBC.cycle files

!   Purpose. 
!   --------
!   Merge entries found in file VARBC.cycle2 which are not present in
!   file VARBC.cycle. The output file is VARBC.cycle_out

!   Interface.
!   ----------

!   Externals.
!   ----------
!   SULUN
!   SUCST
!   SUANCT
!   RDVARBC
!   GTVARBC_GROUPID
!   WRVARBC

!   Author.
!   -------
!   Vincent GUIDARD (Meteo-France)

!   Modifications.
!   --------------
!   Original    2008/03/10

!-----------------------------------------------------------------------

USE parkind1, ONLY : JPIM, JPRB
USE yomhook , ONLY : lhook, dr_hook
USE YOMANA  , ONLY : NANDAT, NANTIM
USE YOMCT0  , ONLY : CNMEXP
USE yomlun  , ONLY : NULOUT, NULERR
USE yomancs , ONLY : NMDI
USE yommp   , ONLY : myproc
USE yomvarbc, ONLY : YVARBC,     NOBGROUP,  NOBPARAM,&
                   & JPMXNGROUP, NBINS,     TYPE_VARBC,&
                   & MPREDXCNT,  APREDMEAN, APREDXCOV,&
                   & MPREDXHST

IMPLICIT NONE

INTEGER(KIND=JPIM) :: igroupid, ibouclejg2, inew
INTEGER(KIND=JPIM) :: inbaddparam,inbaddgrp

INTEGER(KIND=JPIM) :: INOBGROUP2,    INOBPARAM2
INTEGER(KIND=JPIM) :: INOBGROUP_OUT, INOBPARAM_OUT
TYPE(type_varbc), ALLOCATABLE :: YLVARBC2(:)

INTEGER(KIND=JPIM) :: IMPREDXHST1(JPMXNGROUP,NBINS)
INTEGER(KIND=JPIM) :: IMPREDXHST2(JPMXNGROUP,NBINS)

REAL(KIND=JPRB)    :: zhook_handle

#include "gtvarbc_groupid.intfb.h"
#include "rdvarbc.intfb.h"
#include "sulun.intfb.h"
#include "wrvarbc.intfb.h"

IF (lhook) CALL dr_hook('MERGE_VARBC',0,zhook_handle)

CALL SULUN(NULOUT)

CNMEXP(1:4)='MRGE'
NANDAT=19790709
NANTIM=224500

WRITE(NULERR,'(/,a)') 'BEGINNING OF MERGE_VARBC'


! Allocate table for administration of bias groups
! ------------------------------------------------
ALLOCATE(YVARBC(JPMXNGROUP))
ALLOCATE(YLVARBC2(JPMXNGROUP))

! Load table with cycled group definitions and parameter info
! -----------------------------------------------------------
CALL rdvarbc('VARBC.cycle2',YLVARBC2,INOBGROUP2,INOBPARAM2,JPMXNGROUP,IMPREDXHST2)
CALL rdvarbc('VARBC.cycle',YVARBC,NOBGROUP,NOBPARAM,JPMXNGROUP,IMPREDXHST1)

inbaddparam=0
inbaddgrp=0
DO ibouclejg2=1, INOBGROUP2
   CALL gtvarbc_groupid(YLVARBC2(ibouclejg2)%NBUFRID, &
        & YLVARBC2(ibouclejg2)%NSENSOR,YLVARBC2(ibouclejg2)%NCHANNL,&
        & YVARBC,NOBGROUP,igroupid)
   IF (igroupid == NMDI) THEN
      WRITE(NULERR,*) 'new entry found: ',YLVARBC2(ibouclejg2)%NBUFRID, &
        & YLVARBC2(ibouclejg2)%NSENSOR,YLVARBC2(ibouclejg2)%NCHANNL,YLVARBC2(ibouclejg2)%NPARAM
      inbaddgrp   = inbaddgrp+1
      inbaddparam = inbaddparam + YLVARBC2(ibouclejg2)%NPARAM
   ENDIF
ENDDO
WRITE(NULERR,*)
WRITE(NULERR,*) 'new groups found: ',inbaddgrp
WRITE(NULERR,*) 'new params found: ',inbaddparam
 
INOBGROUP_OUT = NOBGROUP + inbaddgrp
INOBPARAM_OUT = NOBPARAM + inbaddparam
MPREDXHST(1:NOBGROUP,:) = IMPREDXHST1(1:NOBGROUP,:)
inew = NOBGROUP + 1
DO ibouclejg2=1, INOBGROUP2
   CALL gtvarbc_groupid(YLVARBC2(ibouclejg2)%NBUFRID, &
        & YLVARBC2(ibouclejg2)%NSENSOR,YLVARBC2(ibouclejg2)%NCHANNL,&
        & YVARBC,NOBGROUP,igroupid)
   IF (igroupid == NMDI) THEN
      YVARBC(inew)  = YLVARBC2(ibouclejg2)
      MPREDXHST(inew,:) = IMPREDXHST2(ibouclejg2,:)
      inew = inew + 1
   ENDIF
ENDDO

myproc = 1
CALL WRVARBC('VARBC.cycle_out',YVARBC(1:INOBGROUP_OUT),INOBGROUP_OUT,INOBPARAM_OUT,&
              & MPREDXHST(1:INOBGROUP_OUT,:))

IF (ALLOCATED(YVARBC))      DEALLOCATE(YVARBC)
IF (ALLOCATED(YLVARBC2))    DEALLOCATE(YLVARBC2)

WRITE(NULERR,'(/,a)') 'END OF MERGE_VARBC'
WRITE(NULERR,'(/,a)') 'PLEASE ACKNOWLEDGE YOUR VARBC HERO'

IF (lhook) CALL dr_hook('MERGE_VARBC',1,zhook_handle)

END PROGRAM MERGE_VARBC
