anchor.diff:              KRHO2 = 1
             END IF
             IF(IDENSI.GE.1)
  -     &    CALL DENSI2(IDENSI,WORK(KRHO1),WORK(KRHO2),
  +     &    CALL DENSI2(IDENSI,dbl_mb(KRHO1),WORK(KRHO2),
        &         KPVEC1,KPVEC2,0,0,EXPS2,ISPNDEN,WORK(KSRHO1),
        &         WORK(KRHO2AA),WORK(KRHO2AB),WORK(KRHO2BB),1)
             IF(IDENSI.EQ.2) THEN
  
positive.code:         WRITE(6,*) ' NCONF_PER_OPEN_ACT array (output) '
          CALL IWRTMA(NCONF_PER_OPEN_ACT,1,MAXOP+1,1,MAXOP+1)
        END IF
  *
        RETURN
        END
        SUBROUTINE SIGDEN_CIGEN(CB,HCB,LUC,LUHC,ITASK)
  *
  * Outer routine for sigma, traci, densi  generation
  * GAS version 
  *
  * IF ICISTR.gt.1, then CB, HCB are two blocks holding a batch
  * IF ICISTR .eq. 1, then CB, HCB are two vectors holding a vector over
  * parameters. Parameters are CSF's if required
  *
  * IF CSF's are active (NOCSF = 0), then three vectors over SD's 
  * must be available (KCOMVECX_SD, X = 1, 2, 3)
  *
  *
  * A new start, March 23, 2012
  *
  * Last modification; Oct. 30, 2012; Jeppe Olsen; changed call to Z_BLKFO
        INCLUDE 'wrkspc.inc'
        CHARACTER*6 ITASK
  *
  * =====
  *.Input
  * =====
  *
  *.Definition of c and sigma
        INCLUDE 'cands.inc'
  *
  *./ORBINP/: NACOB used
        INCLUDE 'orbinp.inc'
        INCLUDE 'cicisp.inc'
        INCLUDE 'strbas.inc'
        INCLUDE 'cstate.inc' 
        INCLUDE 'strinp.inc'
        INCLUDE 'stinf.inc'
        INCLUDE 'csm.inc'
        INCLUDE 'crun.inc'
        INCLUDE 'gasstr.inc'
        INCLUDE 'cgas.inc'
        INCLUDE 'lucinp.inc'
        INCLUDE 'cprnt.inc'
        INCLUDE 'glbbas.inc'
        INCLUDE 'oper.inc'
        INCLUDE 'cecore.inc'
        INCLUDE 'spinfo.inc'
        COMMON/CMXCJ/MXCJ,MAXK1_MX,LSCMAX_MX
  *. Two blocks of C or Sigma (for ICISTR .gt. 2)
        DIMENSION CB(*),HCB(*)
  *. Two vectors of C or Sigma (for ICISTR = 1)
  *
        CALL QENTER('SGDEGN')
  *
        
        NTEST = 010
        IF(NTEST.GE.10) THEN
          WRITE(6,*) 
          WRITE(6,*) 'SIGDEN_CIGEN speaking '
          WRITE(6,*) '===================== '
          WRITE(6,*) 
          WRITE(6,'(A,A6)') ' ITASK = ', ITASK
        END IF 
  *
        IF(NTEST.GE.1000) THEN
          WRITE(6,*) ' Input to SIGDEN_CIGEN '
          WRITE(6,*) ' ======================='
          IF(ICISTR.GT.1) THEN
            CALL WRTVCD(CB,LUC,1,-1)
          ELSE
            CALL WRTMAT(CB,1,NCVAR,1,NCVAR)
          END IF
        END IF
  C?    WRITE(6,*) ' Ecore = ', ECORE
          
        IDUM = 0
        CALL MEMMAN(IDUM,IDUM,'MARK  ',IDUM,'SGDEGN')
  *. For the moment
        ICFIRST = 1
        ISFIRST = 1
  *
        MAXK1_MX = 0
        LSCMAX_MX = 0
        IF(ISSPC.LE.NCMBSPC) THEN
          IATP = 1
          IBTP = 2
        ELSE
          IATP = IALTP_FOR_GAS(ISSPC)
          IBTP = IBETP_FOR_GAS(ISSPC)
        END IF
  *
        NOCTPA = NOCTYP(IATP)
        NOCTPB = NOCTYP(IBTP)
  *. Offset for supergroups 
        IOCTPA = IBSPGPFTP(IATP)
        IOCTPB = IBSPGPFTP(IBTP)
  *
        NAEL = NELEC(IATP)
        NBEL = NELEC(IBTP)
  *. Block for storing complete or partial CI-vector
        IF(ISIMSYM.EQ.0) THEN
          LBLOCK = MXSOOB
        ELSE
          LBLOCK = MXSOOB_AS
        END IF
        IF(NOCSF.EQ.0) THEN
          LBLOCK  = NSD_FOR_OCCLS_MAX
        END IF
        LBLOCK = MAX(LBLOCK,LCSBLK)
  C?    WRITE(6,*) ' TEST, MV7: LCSBLK, LBLOCK = ', LCSBLK, LBLOCK
        ICOMP = 0
        ILTEST = -3006
        IF(ISFIRST.EQ.1) THEN
          CALL Z_BLKFO_FOR_CISPACE(ISSPC,ISSM,LBLOCK,ICOMP,
       &       NTEST,NSBLOCK,NSBATCH,
       &       int_mb(KSIOIO),int_mb(KSBLTP),NSOCCLS_ACT,
       &       dbl_mb(KSIOCCLS_ACT),
       &       int_mb(KSLBT),int_mb(KSLEBT),int_mb(KSLBLK),int_mb(KSI1BT),
       &       int_mb(KSIBT),
       &       int_mb(KSNOCCLS_BAT),int_mb(KSIBOCCLS_BAT),ILTEST)
        END IF
        IF(ICFIRST.EQ.1) THEN
          CALL Z_BLKFO_FOR_CISPACE(ICSPC,ICSM,LBLOCK,ICOMP,
       &       NTEST,NCBLOCK,NCBATCH,
       &       int_mb(KCIOIO),int_mb(KCBLTP),NCOCCLS_ACT,
       &       dbl_mb(KCIOCCLS_ACT),
       &       int_mb(KCLBT),int_mb(KCLEBT),int_mb(KCLBLK),int_mb(KCI1BT),
       &       int_mb(KCIBT),
       &       int_mb(KCNOCCLS_BAT),int_mb(KCIBOCCLS_BAT),ILTEST)
        END IF
  C     WRITE(6,*) ' ECORE in MV7 =', ECORE
  *. Number of BLOCKS
          NBLOCK = NSBLOCK
  C?      WRITE(6,*) ' Number of blocks ', NBLOCK
  
        IF(I12.EQ.2) THEN
          IDOH2 = 1
        ELSE
          IDOH2 = 0
        END IF
  *
        IF(NOCSF.EQ.0.AND.ICNFBAT.GE.2) THEN
  *. Obtain scratch files for saving combination forms of C and Sigma
  C             FILEMAN_MINI(IFILE,ITASK)
           CALL FILEMAN_MINI(LU_CDET,'ASSIGN')
           CALL FILEMAN_MINI(LU_SDET,'ASSIGN')
  C?       WRITE(6,*) ' Test: LU_CDET, LU_SDET: ',
  C?   &                      LU_CDET, LU_SDET
  * ITASK = ASSIGN => Find a free superscratchfile, reserve, set IFILE to 
  * ITASK = FREE   => Free superscratchfile IFILE
        END IF
  *
        IF(ICISTR.EQ.1) THEN
         LLUC = 0
         LLUHC = 0
        ELSE 
         IF(NOCSF.EQ.1) THEN
          LLUC = LUC
          LLUHC = LUHC
         ELSE
          LLUC = LU_CDET
          LLUHC = LU_SDET
         END IF
        END IF
  
        IF(NOCSF.EQ.0) THEN
         IF(ICNFBAT.EQ.1) THEN
  *. In core
           CALL CSDTVCM(CB,WORK(KCOMVEC1_SD),WORK(KCOMVEC2_SD),
       &                1,0,ICSM,ICSPC,2)
         ELSE
  *. Not in core- write determinant expansion on LU_CDET 
  C       CSDTVCMN(CSFVEC,DETVEC,SCR,IWAY,ICOPY,ISYM,ISPC,
  C    &           IMAXMIN_OR_GAS,ICNFBAT,LU_DET,LU_CSF,NOCCLS_ACT,
  C    &           IOCCLS_ACT,IBLOCK,NBLK_PER_BATCH)  
          CALL CSDTVCMN(CB,HCB,WORK(KVEC3),
       &       1,0,ICSM,ICSPC,2,2,LU_CDET,LUC,NCOCCLS_ACT,
       &       WORK(KCIOCCLS_ACT),int_mb(KCIBT),int_mb(KCLBT))
         END IF
        END IF
  *
  C            RASSG3(CB,SB,LBATS,LEBATS,I1BATS,IBATS,LUC,LUHC,C,HC,ECORE)
        IF(ICISTR.GE.2) THEN
          CALL RASSG3(CB,HCB,NSBATCH,int_mb(KSLBT),int_mb(KSLEBT),
       &       int_mb(KSI1BT),int_mb(KSIBT),LLUC,LLUHC,XDUM,XDUM,ECORE,
       &       ITASK)
        ELSE
  *. ICISTR = 1, CB, HCB are the complete vectors
          IF(NOCSF.EQ.1) THEN
  *. CB and HCB on input are the complete vectors
            CALL RASSG3(WORK(KVEC1P),WORK(KVEC2P),NSBATCH,
       &         int_mb(KSLBT),int_mb(KSLEBT),
       &         int_mb(KSI1BT),int_mb(KSIBT),LLUC,LLUHC,CB,HCB,ECORE,
       &         ITASK)
  *. Input is in KCOMVEC1_SD, construct output in KCOMVEC2_SD
          ELSE
            CALL RASSG3(WORK(KVEC1P),WORK(KVEC2P),NSBATCH,
       &         int_mb(KSLBT),int_mb(KSLEBT),
       &         int_mb(KSI1BT),int_mb(KSIBT),LLUC,LLUHC,
       &         WORK(KCOMVEC1_SD),WORK(KCOMVEC2_SD),ECORE,
       &         ITASK)
          END IF ! CSF switch
        END IF ! ICISTR switch
  *
        IF(NOCSF.EQ.0) THEN
  * Transform sigma vector in KCOMVEC2_SD to CSF basis
         IF(ICNFBAT.EQ.1) THEN
  C CSDTVCM(CSFVEC,DETVEC,IWAY,ICOPY,ISYM,ISPC,IMAXMIN_OR_GAS)
           CALL CSDTVCM(HCB,WORK(KCOMVEC2_SD),WORK(KCOMVEC1_SD),
       &        2,0,ISSM,ISSPC,2)
         ELSE
          CALL CSDTVCMN(HCB,CB,WORK(KVEC3),
       &       2,0,ISSM,ISSPC,2,2,LU_SDET,LUHC,NSOCCLS_ACT,
       &       WORK(KSIOCCLS_ACT),WORK(KSIBT),int_mb(KSLBT))
         END IF
        END IF
  *
        IF(NOCSF.EQ.0.AND.ICNFBAT.GE.2) THEN
          CALL FILEMAN_MINI(LU_CDET,'FREE  ')
          CALL FILEMAN_MINI(LU_SDET,'FREE  ')
        END IF
  *
        IF(NTEST.GE.1000) THEN
          IF(ITASK(1:5).EQ.'SIGMA'. OR. ITASK(1:5).EQ.'TRACI') THEN
           WRITE(6,*) ' Output vector from SGDEGN '
           WRITE(6,*) ' ========================= '
           IF(ICISTR.GT.1) THEN
             CALL WRTVCD(CB,LUHC,1,-1)
           ELSE 
             CALL WRTMAT(HCB,1,NSVAR,1,NSVAR)
           END IF
          END IF
        END IF
  *
  *. Eliminate local memory
        CALL MEMMAN(KDUM ,IDUM,'FLUSM ',2,'SGDEGN')
  *
        CALL QEXIT('SGDEGN')
  *
        RETURN
        END
  
negative.code:             IF(IDENSI.EQ.1) THEN
                KRHO2 = 1
              END IF
              CALL DENSI2(IDENSI,dbl_mb(KRHO1),WORK(KRHO2),
       &      KPVEC1,KPVEC2,0,0,EXPS2,ISPNDEN,WORK(KSRHO1),
       &      WORK(KRHO2AA),WORK(KRHO2AB),WORK(KRHO2BB),1)
            ELSE
              CALL REWINO(LUSC1)
              CALL REWINO(LUC)
              CALL COPVCD(LUC,LUSC1,dbl_mb(KVEC1),0,LBLK)
              CALL DENSI2(IDENSI,dbl_mb(KRHO1),WORK(KRHO2),
       &          dbl_mb(KVEC1),dbl_mb(KVEC2),LUC,LUSC1,EXPS2,
       &          ISPNDEN,WORK(KSRHO1),WORK(KRHO2AA),WORK(KRHO2AB),
       &          WORK(KRHO2BB),1 )
  