anchor.diff:            END IF
   *. Obtain block of AB
             CALL EXTR_SYMGAS_BLK_FROM_ORBMAT
  -     &    (WORK(KLVEC),WORK(KLBBLK),ISM,IGAS,JSM,JGAS)
  +     &    (dbl_mb(KLVEC),dbl_mb(KLBBLK),ISM,IGAS,JSM,JGAS)
   *. Obtain density RHO1(ISM,JSM)
   C         GETD1(RHO1B,ISM,IGAS,JSM,JGAS,ISPIN)
  -          CALL GETD1(WORK(KLRHO2B),ISM,IGAS,JSM,JGAS,1)
  +          CALL GETD1(dbl_mb(KLRHO2B),ISM,IGAS,JSM,JGAS,1)
             IF(NTEST.GE.100) THEN
               WRITE(6,*) ' Block of D1 '
  -            CALL WRTMAT(WORK(KLRHO2B),NI,NJ,NI,NJ)
  +            CALL WRTMAT(dbl_mb(KLRHO2B),NI,NJ,NI,NJ)
             END IF
  -          AB1 = AB1 + INPROD(WORK(KLRHO2B),WORK(KLBBLK),NIJ)
  +          AB1 = AB1 + INPROD(dbl_mb(KLRHO2B),dbl_mb(KLBBLK),NIJ)
           END DO ! loop over JGAS
           END DO ! loop over IGAS
         END DO ! Loop over ISM
  
positive.code:      &       NAEL,IATP,NBEL,IBTP,IOCTPA,IOCTPB,NOCTPA,NOCTPB,
       &       NSMST,NSMOB,NSMSX,NSMDX,MXPNGAS,NOBPTS,IOBPTS,      
       &       MAXK,MAXI,LSCR1,LSCR1,WORK(KCSCR),WORK(KSSCR),
       &       SXSTSM,WORK(KSTSTS),WORK(KSTSTD),SXDXSX,
       &       ADSXA,ASXAD,NGAS,NELFSPGP,IDC,
       &       WORK(KI1),WORK(KXI1S),WORK(KI2),WORK(KXI2S),
       &       WORK(KI3),WORK(KXI3S),WORK(KI4),WORK(KXI4S),WORK(KINSCR), 
       &       MXPOBS,IPRDEN,WORK(KRHO1S),LLUL,LLUR,
       &       PSSIGN,PSSIGN,WORK(KRHO1P),WORK(KXNATO),
       &       NBATCHL,WORK(KSLBT),WORK(KSLEBT),WORK(KSI1BT),
       &       WORK(KSIBT),
       &       NBATCHR,WORK(KCLBT),WORK(KCLEBT),WORK(KCI1BT),
       &       WORK(KCIBT),WORK(KCONSPA),WORK(KCONSPB),
       &       WORK(KLSCLFCL),WORK(KLSCLFCR),S2_TERM1,IUSE_PH,IPHGAS,
       &       IDOSRHO1,SRHO1,IDOSRHO2,RHO2AA,RHO2AB,RHO2BB,
       &       NDACTORB,IDACTSPC,IDTFREORD,IFTDREORD,IOBPTS_SEL,
       &       NINOB,ICISTR,LV,RV,ICISTR,NVARL,NVARR,ILTEST)
  
negative.code:       ZERO = 0.0D0
        CALL SETVEC(H,ZERO,NTOOB**2)
  *
  c     IOFF = IFRMR(WORK(KPGINT1A(1)),1,KSM)
        IOFF = dbl_mb(KPGINT1A(1) + KSM - 1)
        CALL COPVEC(T(IOFF+(KREL-1)*NK),H(IOFF+(KREL-1)*NK),NK)
        TKK = H(IOFF-1+(KREL-1)*NK+KREL)
        IF(TKK .NE. 0.0D0) THEN
  