! -------------------------------------------------------------------------
! Bernese GNSS Software Version 5.3
! -------------------------------------------------------------------------

MODULE s_DCBSTORE

  IMPLICIT NONE

#include "COM_CPU.inc"

CONTAINS

SUBROUTINE dcbstore(neq)

! -------------------------------------------------------------------------
! Purpose:    Save DCB results computed by ADDNEQ2
!
! Author:     S. Schaer
!
! Created:    18-May-2000
!
! Changes:    05-Oct-2000 SS: Use "opt%title"
!             26-Jun-2001 RD: Use alcerr for allocation
!             21-Dec-2001 HU: Use m_bern, ONLY for modules
!             21-Dec-2001 HU: m_addneq replaced by p_addneq
!             26-Mar-2002 SS: Use "filtitle"
!             07-Aug-2002 SS: Print DCB multiplier summary
!             17-Sep-2002 SS: Check also "x0" to detect unobserved DCBs
!             22-Sep-2005 RD: Use new module D_NEQ.f90
!             13-Feb-2008 RD: Adapt to par%name == chr*20
!             19-Nov-2008 AS: Expand sysStr for system "E"
!             10-May-2009 RD: Frequency-dependent code biases
!             13-Aug-2010 RD: Warning in case of huge IFB
!             08-Jul-2011 LP: Use and fill up t_dcbFil structure from BSW6.0;
!                             use g_svnsys instead of sysstr; write bias SINEX
!             21-Jul-2011 LP: Add obstypes to dcbFil%dcbLst
!             28-Mar-2012 RD: Use SVN2CHR as module now
!             28-Mar-2012 RD: Use F_SVNSYS as module now
!             01-May-2012 LP: Replace r32r2 by OBSTYPESR3
!             13-Jun-2012 LP: Define a time window for P1-P2 DCBs
!             18-Jul-2013 SC: fileNameLength80 -> fileNameLength
!             22-Nov-2013 LP: Write hardwired obstypes for GAL ISB (provisorial)
!             20-May-2014 LP: Write hardwired obstypes for BEI ISB (provisorial)
!             17-May-2016 AV: Adapt routine to osb implementation
!             26-May-2016 AV: Bugfix in frequency mode
!             28-Jun-2016 AV: Use clsmul for OSB multipliers
!             26-Oct-2016 AV: Extend OSB validity for OSB and BIASINEX
!             28-Nov-2016 PF: Add srName, call cpu_enter and cpu_exit
!             12-Dec-2016 AV: Bugfix system character for frequency mode
!             10-Apr-2017 ST: Move IMPLICIT NONE to module scope
!             10-Apr-2017 ST: Add #include "COM_CPU.inc"
!             10-Apr-2017 ST: Add IF(srfDebug) in front of CALL cpu_
!             07-Aug-2017 AV: Check opt%dcbOut instead of gtflna
!             18-Jun-2019 SS: Removed unused COMFREQ.inc
!             22-Dec-2020 RD: Transform D_CONST to a protected structure CONST
!             27-Apr-2022 AV/ST: Replace obsTypesR3 with calcObsTypeFromHash.
!             07-Jun-2022 AV: Make neq INTENT(IN)
!             26-Jan-2024 SS: Provide true SVN numbers (including Bernese OSB)
!
! Copyright:  Astronomical Institute
!             University of Bern
!             Switzerland
! -------------------------------------------------------------------------

  USE m_bern,   ONLY: i4b, r8b, lfnerr, fileNameLength
  USE m_cpu,    ONLY: cpu_enter, cpu_exit
  USE s_osbfrq, ONLY: osbfrq_cmbFlg
  USE m_time,   ONLY: t_timint
  USE m_maxdim, ONLY: maxsat, maxsta
  USE d_neq,    ONLY: t_neq
  USE p_addneq, ONLY: opt,comstat
  USE d_const,  ONLY: CONST
  USE d_dcbFil, ONLY: t_dcbFil,init_dcbFil
  USE m_global, ONLY: g_svnsys
  USE d_rinex3, ONLY: calcObsTypeFromHash
  USE f_ikf
  USE s_clsmul
  USE s_alcerr
  USE s_wtosbfl
  USE s_wtbiassnx
  USE s_gtflna
  USE s_prn2svn
  USE s_blksat
  USE f_listi4

! List of arguments
! -----------------
  TYPE(t_neq), INTENT(IN) :: neq

! Local parameters
! ----------------
  CHARACTER(LEN=*), PARAMETER :: srName = 'dcbstore'

! Local Variables
! ---------------
  INTEGER(i4b)                                    :: iac
  INTEGER(i4b)                                    :: ipar
  INTEGER(i4b)                                    :: iIfb
  INTEGER(i4b)                                    :: iIdx
  INTEGER(i4b)                                    :: numsat
  INTEGER(i4b)                                    :: numrec
  INTEGER(i4b)                                    :: numblk
  INTEGER(i4b)                                    :: icbtyp
  INTEGER(i4b), DIMENSION(:)  , ALLOCATABLE       :: dcbid1
  INTEGER(i4b), DIMENSION(:)  , ALLOCATABLE       :: dcbin1
  INTEGER(i4b), DIMENSION(:,:), ALLOCATABLE       :: dcbob1
  INTEGER(i4b), DIMENSION(:)  , ALLOCATABLE       :: dcbsa2
  INTEGER(i4b), DIMENSION(:,:), ALLOCATABLE       :: dcbin2
  INTEGER(i4b), DIMENSION(:,:), ALLOCATABLE       :: dcbob2
  INTEGER(i4b), DIMENSION(:)  , ALLOCATABLE       :: dcbsa3
  INTEGER(i4b), DIMENSION(:,:), ALLOCATABLE       :: dcbin3
  INTEGER(i4b), DIMENSION(:,:), ALLOCATABLE       :: dcbob3
  INTEGER(i4b)                                    :: dcbmod
  INTEGER(i4b)                                    :: dcbsrc
  INTEGER(i4b), DIMENSION(maxsat)                 :: prnlst
  INTEGER(i4b)                                    :: prnnum
  INTEGER(i4b), DIMENSION(maxsat)                 :: osbPrt
  INTEGER(i4b), DIMENSION(maxsat)                 :: osbIdx
  INTEGER(i4b)                                    :: nPrt

  REAL(r8b)                                       :: dcbval
  REAL(r8b)                                       :: dcbrms
  REAL(r8b),    DIMENSION(:,:), ALLOCATABLE       :: dcbva1
  REAL(r8b),    DIMENSION(:,:), ALLOCATABLE       :: dcbva2
  REAL(r8b),    DIMENSION(:,:), ALLOCATABLE       :: dcbva3
  REAL(r8b)                                       :: maxtim
  REAL(r8b)                                       :: exttim

  CHARACTER(LEN=16), DIMENSION(:), ALLOCATABLE    :: dcbid2
  CHARACTER(LEN=16), DIMENSION(:), ALLOCATABLE    :: dcbid3
  CHARACTER(LEN=1), DIMENSION(:), ALLOCATABLE     :: dcbsys2
  CHARACTER(LEN=1), DIMENSION(:), ALLOCATABLE     :: dcbsys3
  CHARACTER(LEN=4), DIMENSION(:), ALLOCATABLE     :: dcbsvn1
  CHARACTER(LEN=4), DIMENSION(:), ALLOCATABLE     :: dcbsvn2
  CHARACTER(LEN=4), DIMENSION(:), ALLOCATABLE     :: dcbsvn3

  TYPE(t_timint)                                  :: timint
  TYPE(t_timint)                                  :: timtmp
  TYPE(t_timint), DIMENSION(:), ALLOCATABLE       :: dcbtim1
  TYPE(t_timint), DIMENSION(:), ALLOCATABLE       :: dcbtim2
  TYPE(t_timint), DIMENSION(:), ALLOCATABLE       :: dcbtim3

  TYPE(t_dcbFil)                                  :: dcbFil
  CHARACTER(LEN=fileNameLength)                   :: dcbSnx
  CHARACTER(LEN=4)                                :: svnBN
  INTEGER(i4b)                                    :: nDcb, ityp1, ityp2, ii, isys
  INTEGER(i4b)                                    :: irc, ircs

! DEBUG: entry
! ------------
  IF (srfDebug) CALL cpu_enter(srName)

! Multiplier
! ----------
  CALL clsmul(neq)

! Nothing to do
! -------------
  CALL gtFlNa(0,'BIASSNX',dcbSnx,ircs)

  IF (ircs == 1 .AND. opt%dcbOut== "" ) THEN

! DEBUG: exit
! ------------
    IF (srfDebug) CALL cpu_exit(srName)

    RETURN
  ENDIF


! Some initializations
! --------------------
  CALL init_dcbFil(dcbFil)

  numsat = 0
  numrec = 0
  numblk = 0
  icbtyp = 0
  maxtim = 0d0

  dcbmod = opt%osb%ocbmod
  dcbsrc = 0

! Count number of satellites and receivers
! ----------------------------------------

  DO ipar = 1,neq%misc%npar
    IF ( neq%par(ipar)%locq(1) == 8 ) THEN
      dcbsrc = osbfrq_cmbFlg(dcbsrc,neq%par(ipar)%locq(4))
     ! Get last valid time
      IF( neq%par(ipar)%time%mean+neq%par(ipar)%time%half > maxtim) &
          maxtim = neq%par(ipar)%time%mean+neq%par(ipar)%time%half

      IF ( neq%par(ipar)%locq(2) == 1 ) THEN      !Satellite biases
        numsat = numsat + 1
      ELSE
        IF(neq%par(ipar)%locq(2) == 2 ) THEN      !Receiver-system
          numrec = numrec + 1
        ELSEIF(neq%par(ipar)%locq(2) == 3 ) THEN  !Receiver-satellite
          numrec = numrec + 1
        ELSEIF(neq%par(ipar)%locq(2) == 4 ) THEN  !Receiver-block
           IF(neq%par(ipar)%locq(5)<1000) THEN
             CALL BLKSAT(neq%par(ipar)%locq(5)/10,0,     &
                         MOD(neq%par(ipar)%locq(5),10)-1,&
                         neq%par(ipar)%time%mean,prnlst,prnnum)
             numblk = numblk + prnnum
           ELSE
             isys = MOD(neq%par(ipar)%locq(5),10)-1
             DO ii=1,opt%osb%indnum(isys)
               IF(opt%osb%indsat(isys,ii)/1000 == &
                  neq%par(ipar)%locq(5)/1000) numblk=numblk+1
             ENDDO
          ENDIF
        ELSEIF(neq%par(ipar)%locq(2) == 5 ) THEN  !Frequency
           CALL BLKSAT(0,neq%par(ipar)%locq(5)/10-10,   &
                       MOD(neq%par(ipar)%locq(5),10)-1, &
                       neq%par(ipar)%time%mean,         &
                       prnlst,prnnum)
           numblk = numblk + prnnum
        ENDIF
      END IF
    END IF
  END DO

! Return, if no DCB-related info found
! ------------------------------------
  IF ( numsat + numrec + numblk == 0 ) THEN
    IF ((opt%dcbout /= '').OR.(ircs==0)) &
      WRITE(lfnerr,'(/,A,A,/)') ' ### SR DCBSTORE: ', &
      'No DCB-related information found'

! DEBUG: exit
! -----------
    IF (srfDebug) CALL cpu_exit(srName)

    RETURN
  ELSE
    dcbFil%nVal = numsat + numrec + numblk
  END IF

! Allocate the arrays
! -------------------
  ALLOCATE( dcbid1(numsat),   stat=iac )
  CALL alcerr(iac, 'dcbid1', (/ numsat /), srName)
  dcbid1 = 0
  ALLOCATE( dcbob1(2,numsat),   stat=iac )
  CALL alcerr(iac, 'dcbob1', (/ 2,numsat /), srName)
  dcbob1 = 0
  ALLOCATE( dcbin1(numsat),   stat=iac )
  CALL alcerr(iac, 'dcbin1', (/ numsat /), srName)
  dcbin1 = 0
  ALLOCATE( dcbva1(2,numsat), stat=iac )
  CALL alcerr(iac, 'dcbva1', (/2,numsat/), srName)
  dcbva1 = 0d0
  ALLOCATE( dcbtim1(numsat),   stat=iac )
  CALL alcerr(iac, 'dcbtim1', (/ numsat /),srName)
  dcbtim1(:)%t(1)  = 0d0
  dcbtim1(:)%t(2)  = 0d0
  ALLOCATE( dcbsvn1(numsat),   stat=iac )
  CALL alcerr(iac, 'dcbsvn1', (/numsat/), srName)
  dcbsvn1 = '    '

  ALLOCATE( dcbid2(numrec),   stat=iac )
  CALL alcerr(iac, 'dcbid2', (/ numrec /), srName)
  dcbid2 = ''
  ALLOCATE( dcbob2(2,numrec),   stat=iac )
  CALL alcerr(iac, 'dcbob2', (/ 2,numrec /), srName)
  dcbob2 = 0
  ALLOCATE( dcbin2(2,numrec),   stat=iac )
  CALL alcerr(iac, 'dcbin2', (/ 2,numrec /), srName)
  dcbin2 = 0
  ALLOCATE( dcbva2(2,numrec), stat=iac )
  CALL alcerr(iac, 'dcbva2', (/2,numrec/), srName)
  dcbva2 = 0d0
  ALLOCATE( dcbsys2(numrec),   stat=iac )
  CALL alcerr(iac, 'dcbsys2', (/ numrec /), srName)
  dcbsys2 = ''
  ALLOCATE( dcbsa2(numrec),   stat=iac )
  CALL alcerr(iac, 'dcbsa2', (/ numrec /), srName)
  dcbsa2 = 0
  ALLOCATE( dcbtim2(numrec),   stat=iac )
  CALL alcerr(iac, 'dcbtim2', (/ numrec /),srName)
  dcbtim2(:)%t(1)  = 0d0
  dcbtim2(:)%t(2)  = 0d0
  ALLOCATE( dcbsvn2(numrec),   stat=iac )
  CALL alcerr(iac, 'dcbsvn2', (/numrec/), srName)
  dcbsvn2 = '    '

  ALLOCATE( dcbid3(numblk),   stat=iac )
  CALL alcerr(iac, 'dcbid3', (/ numblk /), srName)
  dcbid3 = ''
  ALLOCATE( dcbob3(2,numblk),   stat=iac )
  CALL alcerr(iac, 'dcbob3', (/ 2,numblk /), srName)
  dcbob3 = 0
  ALLOCATE( dcbva3(2,numblk), stat=iac )
  CALL alcerr(iac, 'dcbva3', (/4,numblk/), srName)
  dcbva3 = 0d0
  ALLOCATE( dcbin3(2,numblk),   stat=iac )
  CALL alcerr(iac, 'dcbin3', (/ 2,numblk /), srName)
  dcbin3 = 0
  ALLOCATE( dcbsys3(numblk),   stat=iac )
  CALL alcerr(iac, 'dcbsys3', (/ numblk /), srName)
  dcbsys3 = ''
  ALLOCATE( dcbsa3(numblk),   stat=iac )
  CALL alcerr(iac, 'dcbsa3', (/ numrec /), srName)
  dcbsa3 = 0
  ALLOCATE( dcbtim3(numblk),   stat=iac )
  CALL alcerr(iac, 'dcbtim3', (/ numblk /),srName)
  dcbtim2(:)%t(1)  = 0d0
  dcbtim2(:)%t(2)  = 0d0
  ALLOCATE( dcbsvn3(numblk),   stat=iac )
  CALL alcerr(iac, 'dcbsvn3', (/numblk/), srName)
  dcbsvn3 = '    '

  ALLOCATE(dcbFil%dcbLst(dcbFil%nVal),stat=iac)
  CALL alcErr(iac,'dcbFil%dcbLst',(/dcbFil%nVal/), srName)

! Fill the arrays
! ---------------
  numsat = 0
  numrec = 0
  numblk = 0
  nDCB   = 0

! Extended validity
  exttim = maxtim + opt%osb%extval

  DO ipar = 1,neq%misc%npar

    ityp1=-1
    ityp2=-1

    IF ( neq%par(ipar)%locq(1) /= 8 ) CYCLE
!    IF (neq%par(iPar)%locq(2) == 3) CYCLE

    dcbval = neq%xxx(ipar) + neq%par(ipar)%x0
    dcbrms = comstat%rms * SQRT(ABS(neq%anor(ikf(ipar,ipar))))

    IF ( dcbrms == 0.0d0 .OR. neq%xxx(ipar) == 0.0d0 ) THEN
      IF ( opt%dcbout /= '' ) &
        WRITE(lfnerr,'(/,A,/)') ' ### SR DCBSTORE: Unobserved DCB not saved'
      CYCLE
    END IF

    timint%t(1) = neq%par(ipar)%time%mean - neq%par(ipar)%time%half
    timint%t(2) = neq%par(ipar)%time%mean + neq%par(ipar)%time%half

! Extend OSB validity
! -------------------
  IF(opt%osb%extval > 0d0 .AND. timint%t(2)==maxtim) &
      timint%t(2) = exttim


! Satellite DCB
! -------------
    IF ( neq%par(ipar)%locq(2) == 1 ) THEN
! Fill dcbFil structure
      nDCB = nDcb+1
      dcbFil%dcbLst(nDCB)%dcbVal = dcbval
      dcbFil%dcbLst(nDCB)%dcbRms = dcbrms
      dcbFil%dcbLst(nDCB)%flg    = "R"
      dcbFil%dcbLst(nDCB)%tim    = timint
      dcbFil%dcbLst(nDCB)%rem    = ""
      dcbFil%dcbLst(nDCB)%obstyp(1) = "   "
      dcbFil%dcbLst(nDCB)%obstyp(2) = "   "
      dcbFil%dcbLst(nDCB)%prn=neq%par(ipar)%locq(3)/10000
      dcbFil%dcbLst(nDCB)%svn=MOD(neq%par(ipar)%locq(3),10000)
      dcbFil%dcbLst(nDCB)%staNam = ""

      IF(neq%par(iPar)%locq(5)<1000) THEN
         ityp1=neq%par(iPar)%locq(5)
         dcbFil%dcbLst(nDCB)%obstyp(1) = calcObsTypeFromHash(ityp1)
         ityp2=-1
         dcbFil%dcbLst(nDCB)%typ    = 1
      ELSE
        ityp1=neq%par(iPar)%locq(5)/1000
        ityp2=MOD(neq%par(iPar)%locq(5),1000)
        dcbFil%dcbLst(nDCB)%obstyp(1) = calcObsTypeFromHash(ityp1)
        dcbFil%dcbLst(nDCB)%obstyp(2) = calcObsTypeFromHash(ityp2)
        dcbFil%dcbLst(nDCB)%typ    = 2
     ENDIF
      numsat           = numsat + 1
      CALL PRN2SVN(0,neq%par(ipar)%locq(3)/10000,            &
                   neq%par(ipar)%time%mean,svnBN,timtmp,irc, &
                   svnTN=dcbsvn1(numsat))
      dcbid1(numsat)   = neq%par(ipar)%locq(3)/10000
      dcbva1(1,numsat) = dcbval
      dcbva1(2,numsat) = dcbrms
      dcbob1(1,numsat) = ityp1
      dcbob1(2,numsat) = ityp2
      dcbtim1(numsat)  = timint
      dcbFil%dcbLst(nDCB)%sys    = dcbsvn1(numsat)(1:1)

      dcbFil%dcbLst(nDCB)%staNam = TRIM(neq%par(iPar)%name)
      ! Standard obstypes (hardwired in D_RINEX3)
      dcbFil%dcbLst(nDCB)%obstyp(1) = calcObsTypeFromHash(ityp1)
      IF(ityp2 /= -1)  THEN
        dcbFil%dcbLst(nDCB)%obstyp(2) = calcObsTypeFromHash(ityp2)
        dcbFil%dcbLst(nDCB)%typ    = 2
      ELSE
        dcbFil%dcbLst(nDCB)%obstyp(2) = "   "
        dcbFil%dcbLst(nDCB)%typ    = 1
      ENDIF

      ! READ(dcbsvn1(numsat)(2:4),'(I3)',iostat=irc) dcbFil%dcbLst(nDCB)%svn

! Station DCB
! -----------
    ELSE
      IF(neq%par(iPar)%locq(6)<1000) THEN
        ityp1=neq%par(iPar)%locq(6)
        ityp2=-1
      ELSE
        ityp1=INT(neq%par(iPar)%locq(6)/1000)
        ityp2=MOD(neq%par(iPar)%locq(6),1000)
      ENDIF

      IF( neq%par(iPar)%locq(2)== 2 .OR. neq%par(iPar)%locq(2)== 3) THEN
        nDCB = nDcb+1
        dcbFil%dcbLst(nDCB)%dcbVal = dcbval
        dcbFil%dcbLst(nDCB)%dcbRms = dcbrms
        dcbFil%dcbLst(nDCB)%flg    = "R"
        dcbFil%dcbLst(nDCB)%tim    = timint
        dcbFil%dcbLst(nDCB)%rem    = ""
        dcbFil%dcbLst(nDCB)%obstyp(1) = "   "
        dcbFil%dcbLst(nDCB)%obstyp(2) = "   "

        numrec           = numrec + 1

        dcbid2(numrec)   = (neq%par(ipar)%name)
        dcbsvn2(numrec)(2:4)  = "   "

        IF(neq%par(ipar)%locq(2) == 2 ) THEN
          dcbsys2(numrec)         = g_svnsys(neq%par(iPar)%locq(5)-1)
          dcbFil%dcbLst(nDCB)%svn = 0
        ELSEIF(neq%par(ipar)%locq(2) == 3 ) THEN
          CALL PRN2SVN(0,neq%par(ipar)%locq(5)/10000,            &
                       neq%par(ipar)%time%mean,svnBN,timtmp,irc, &
                       svnTN=dcbsvn2(numrec))
          dcbsys2(numrec)  = g_svnsys(INT(neq%par(iPar)%locq(5)/100/10000))
          dcbFil%dcbLst(nDCB)%prn    = neq%par(iPar)%locq(5)/10000
          dcbFil%dcbLst(nDCB)%svn    = MOD(neq%par(iPar)%locq(5),10000)
        ENDIF
        dcbsvn2(numrec)(1:1)  = dcbsys2(numrec)

        IF(neq%par(iPar)%locq(2)== 2) THEN
          dcbsa2(numrec)   = 0
        ELSE
          dcbsa2(numrec)   = neq%par(iPar)%locq(5)/10000
        ENDIF
        dcbva2(1,numrec) = dcbval
        dcbva2(2,numrec) = dcbrms
        dcbob2(1,numrec) = ityp1
        dcbob2(2,numrec) = ityp2
        dcbtim2(numrec)  = timint
        dcbFil%dcbLst(nDCB)%sys    = dcbsys2(numrec)
        dcbFil%dcbLst(nDCB)%staNam = TRIM(neq%par(iPar)%name)
        ! Standard obstypes (hardwired in D_RINEX3)
        dcbFil%dcbLst(nDCB)%obstyp(1) = calcObsTypeFromHash(ityp1)
        IF(ityp2 /= -1)  THEN
          dcbFil%dcbLst(nDCB)%obstyp(2) = calcObsTypeFromHash(ityp2)
          dcbFil%dcbLst(nDCB)%typ    = 2
        ELSE
          dcbFil%dcbLst(nDCB)%obstyp(2) = "   "
          dcbFil%dcbLst(nDCB)%typ    = 1
        ENDIF

      ELSEIF( neq%par(iPar)%locq(2)== 4 .OR. neq%par(iPar)%locq(2)== 5 ) THEN ! Receiver-block
        prnlst = 0
        prnnum = 0
        isys = MOD(neq%par(ipar)%locq(5),10)-1
        IF( neq%par(iPar)%locq(2)== 4  ) THEN
          IF( neq%par(iPar)%locq(5) < 10000) THEN
            CALL BLKSAT(neq%par(ipar)%locq(5)/10,0,      &
                        MOD(neq%par(ipar)%locq(5),10)-1, &
                        neq%par(ipar)%time%mean,         &
                        prnlst,prnnum)
          ELSE
            DO ii=1,opt%osb%indnum(isys)
              IF(opt%osb%indsat(isys,ii)/1000 == &
                 neq%par(ipar)%locq(5)/10000) THEN
                 prnnum = prnnum+1
                 prnlst(prnnum) = &
                     MOD(opt%osb%indsat(isys,ii),1000)
              ENDIF
            ENDDO
          ENDIF
        ELSE
          CALL BLKSAT(0,neq%par(ipar)%locq(5)/10-10,   &
                      MOD(neq%par(ipar)%locq(5),10)-1, &
                      neq%par(ipar)%time%mean,         &
                      prnlst,prnnum)
        ENDIF
        DO ii=1,prnnum
          numblk           = numblk + 1
          nDCB = nDcb+1
          dcbid3(numblk)   = neq%par(ipar)%name
          dcbsvn3(numblk)(1:4)  = "    "
          CALL PRN2SVN(0,prnlst(ii),                             &
                       neq%par(ipar)%time%mean,svnBN,timtmp,irc, &
                       svnTN=dcbsvn3(numblk))
          dcbsys3(numblk)  = g_svnsys(prnlst(ii)/100)
          dcbFil%dcbLst(nDCB)%prn    = prnlst(ii)
          READ(dcbsvn3(numblk)(2:4),'(I3)') dcbFil%dcbLst(nDCB)%svn
          dcbsa3(numblk)   = prnlst(ii)
          dcbva3(1,numblk) = dcbval
          dcbva3(2,numblk) = dcbrms
          dcbob3(1,numblk) = ityp1
          dcbob3(2,numblk) = ityp2
          dcbtim3(numblk)  = timint

          dcbFil%dcbLst(nDCB)%dcbVal = dcbval
          dcbFil%dcbLst(nDCB)%dcbRms = dcbrms
          dcbFil%dcbLst(nDCB)%flg    = "R"
          dcbFil%dcbLst(nDCB)%tim    = timint
          dcbFil%dcbLst(nDCB)%rem    = ""
          dcbFil%dcbLst(nDCB)%obstyp(1) = "   "
          dcbFil%dcbLst(nDCB)%obstyp(2) = "   "
          dcbsvn3(numblk)(1:1)  = dcbsys3(numblk)
          dcbFil%dcbLst(nDCB)%sys    = dcbsys3(numblk)
          dcbFil%dcbLst(nDCB)%staNam = TRIM(neq%par(iPar)%name)
          dcbFil%dcbLst(nDCB)%obstyp(1) = calcObsTypeFromHash(ityp1)
          IF(ityp2 /= -1)  THEN
             dcbFil%dcbLst(nDCB)%obstyp(2) = calcObsTypeFromHash(ityp2)
             dcbFil%dcbLst(nDCB)%typ    = 2
          ELSE
             dcbFil%dcbLst(nDCB)%obstyp(2) = "   "
             dcbFil%dcbLst(nDCB)%typ    = 1
          ENDIF
        ENDDO
      ENDIF

! ! Print ADDNEQ2 DCB multipliers summary
! ! -------------------------------------
!       IF ( neq%par(ipar)%locq(6) == -2 ) THEN

!         IF ( numrec == 1 ) WRITE(lfnprt,"(//,A,/,A,//,A,A,/,1X,1DCB31('-'))") &
!           ' DCB Multiplier Summary:', &
!           ' -----------------------', &
!           ' Station name           Multiplier   RMS error    ', &
!           'Suggested receiver type'

!         CALL clsrcv(dcbval,dcbrms,iclass,clsstr,clsfac)

!         WRITE(lfnprt,"(1X,A20,'-',A1,1X,2F13.3,4X,A5,2F8.3)") &
!           neq%par(ipar)%name,g_svnsys(neq%par(iPar)%locq(5)-1),dcbval,dcbrms, &
!           clsstr,clsfac(1),clsfac(2)

!       END IF
    END IF
  ENDDO

! Check for exceptional big IFB
! Only for clock analysis
! -----------------------------
  osbPrt = 0
  osbIdx = 0
  nPrt   = 0

  if( opt%osb%ocbMod==1 ) THEN
    DO iIfb = 1,nDcb
      IF(dcbFil%dcbLst(iIfb)%staNam=='') CYCLE ! Satellite bias
      IF(dcbFil%dcbLst(iIfb)%prn==0    ) CYCLE ! System
      IF(DABS(dcbFil%dcbLst(iIfb)%dcbVal) >  opt%maxIfb) THEN
        iIdx = listi4(1,maxsat,osbPrt,dcbFil%dcbLst(iIfb)%prn,nPrt)
       IF( osbIdx(iIdx) == 0 ) THEN
          osbIdx(iIdx) = iIfb
        ELSEIF(DABS(dcbFil%dcbLst(iIfb)%dcbVal) > &
               DABS(dcbFil%dcbLst(osbIdx(iIdx))%dcbVal)) THEN
          osbIdx(iIdx) = iIfb
        ENDIF
      ENDIF
    ENDDO

    IF(nPrt > 0) THEN

      DO iIfb=1,nPrt
        WRITE(lfnerr,'(/,A,A1,I2.2,A1,A/)')                               &
        ' ### DCBSTORE: Exceptional OSB found for sat/sta: ',             &
        dcbFil%dcbLst(osbIdx(iIfb))%flg,                                  &
        MOD(dcbFil%dcbLst(osbIdx(iIfb))%prn,100),                         &
        ':',dcbFil%dcbLst(osbIdx(iIfb))%stanam
      ENDDO
    ENDIF
  ENDIF

! Save the results
! ----------------
  IF (opt%dcbout /= '' .AND. icbtyp /= -2) &
    CALL wtosbfl(opt%dcbout,CONST%filtitle,numsat , numrec,   &
                numblk    ,dcbid1  ,dcbva1 , dcbob1, dcbsvn1, &
                dcbid2    ,dcbva2  ,dcbsys2, dcbsa2, dcbob2 , &
                dcbsvn2   ,dcbid3  ,dcbva3 , dcbob3, dcbsys3, &
                dcbsa3    ,dcbsvn3, dcbin1  ,dcbin2, dcbin3 , &
                dcbmod    ,dcbsrc,                            &
                dcbtim1=dcbtim1,dcbtim2=dcbtim2,dcbtim3=dcbtim3)
  dcbFil%nVal = nDCB
  IF (icbtyp /= -2) CALL WTBIASSNX(dcbFil,neq%misc%nSmpNq)

  DEALLOCATE( dcbid1 , stat=iac )
  DEALLOCATE( dcbob1 , stat=iac )
  DEALLOCATE( dcbin1 , stat=iac )
  DEALLOCATE( dcbva1 , stat=iac )
  DEALLOCATE( dcbtim1, stat=iac )
  DEALLOCATE( dcbsvn1, stat=iac )

  DEALLOCATE( dcbid2 , stat=iac )
  DEALLOCATE( dcbob2 , stat=iac )
  DEALLOCATE( dcbva2 , stat=iac )
  DEALLOCATE( dcbin2 , stat=iac )
  DEALLOCATE( dcbsys2, stat=iac )
  DEALLOCATE( dcbsa2 , stat=iac )
  DEALLOCATE( dcbtim2, stat=iac )
  DEALLOCATE( dcbsvn2, stat=iac )

  DEALLOCATE( dcbid3 , stat=iac )
  DEALLOCATE( dcbob3 , stat=iac )
  DEALLOCATE( dcbva3 , stat=iac )
  DEALLOCATE( dcbin3 , stat=iac )
  DEALLOCATE( dcbsys3, stat=iac )
  DEALLOCATE( dcbsa3 , stat=iac )
  DEALLOCATE( dcbtim3, stat=iac )
  DEALLOCATE( dcbsvn3, stat=iac )

  DEALLOCATE( dcbFil%dcbLst, stat=iac )

! DEBUG: exit
! -----------
  IF (srfDebug) CALL cpu_exit(srName)

  RETURN
END SUBROUTINE dcbstore

END MODULE s_DCBSTORE
