CalcDoCalc Subroutine

public subroutine CalcDoCalc(kp)

Arguments

Type IntentOptional Attributes Name
type(kp_fciqmc_data), intent(inout) :: kp

Contents

Source Code


Source Code

    subroutine CalcDoCalc(kp)
        use SystemData, only: Alat, Arr, Brr, Beta, ECore, G1, LMS, LMS2, nBasis, NMSH, nBasisMax
        use SystemData, only: SymRestrict, tParity, tSpn, ALat, Beta, tMolpro, tMolproMimic
        use SystemData, only: Symmetry, SymmetrySize, SymmetrySizeB, BasisFN, BasisFNSize, BasisFNSizeB, nEl
        Use DetCalcData, only: nDet, nEval, nmrks, w
        USE FciMCParMod, only: FciMCPar
        use RPA_Mod, only: RunRPA_QBA
        use DetCalc, only: CK, DetInv, tEnergy, tRead
        use IntegralsData, only: FCK, NMAX, UMat, FCK
        use IntegralsData, only: HFEDelta, HFMix, nTay
        Use LoggingData, only: iLogging
        use Parallel_Calc
        use util_mod, only: get_free_unit, NECI_ICOPY
        use sym_mod
        use davidson_neci, only: DavidsonCalcType, DestroyDavidsonCalc
        use davidson_neci, only: davidson_direct_ci_init, davidson_direct_ci_end, perform_davidson
        use hamiltonian_linalg, only: direct_ci_type
        use kp_fciqmc, only: perform_kp_fciqmc, perform_subspace_fciqmc
        use kp_fciqmc_data_mod, only: tExcitedStateKP
        use kp_fciqmc_procs, only: kp_fciqmc_data
        use util_mod, only: int_fmt

        real(dp) :: EN, WeightDum, EnerDum
        real(dp), allocatable :: final_energy(:)
        integer :: iSeed, iunit, i
        type(kp_fciqmc_data), intent(inout) :: kp
        character(*), parameter :: this_routine = 'CalcDoCalc'
        type(DavidsonCalcType) :: davidsonCalc

        iSeed = 7

        IF(tMP2Standalone) then
            call ParMP2(FDet)
            ! Parallal 2v sum currently for testing only.
            !          call Par2vSum(FDet)
        ELSE IF(tDavidson) then
            davidsonCalc = davidson_direct_ci_init()
            if(t_non_hermitian_2_body) then
                call stop_all(this_routine, &
                              "perform_davidson not adapted for non-hermitian Hamiltonians!")
            end if
            if(tGUGA) then
                call stop_all(this_routine, &
                              "perform_davidson not adapted for GUGA yet")
            end if
            call perform_davidson(davidsonCalc, direct_ci_type, .true.)
            call davidson_direct_ci_end(davidsonCalc)
            call DestroyDavidsonCalc(davidsonCalc)
        else if(allocated(pgen_unit_test_spec)) then
            call batch_run_excit_gen_tester(pgen_unit_test_spec)

        ELSE IF(NPATHS /= 0 .OR. DETINV > 0) THEN
            !Old and obsiolecte
            !             IF(TRHOIJND) THEN
            !C.. We're calculating the RHOs for interest's sake, and writing them,
            !C.. but not keeping them in memory
            !                  write(stdout,*) "Calculating RHOS..."
            !                  write(stdout,*) "Using approx NTAY=",NTAY
            !                  CALL CALCRHOSD(NMRKS,BETA,I_P,I_HMAX,I_VMAX,NEL,NDET,        &
            !     &               NBASISMAX,G1,nBasis,BRR,NMSH,FCK,NMAX,ALAT,UMAT,             &
            !     &               NTAY,RHOEPS,NWHTAY,ECORE)
            !             end if

            if(tFCIMC) then
                call FciMCPar(final_energy)
                if((.not. tMolpro) .and. (.not. tMolproMimic)) then
                    if(allocated(final_energy)) then
                        do i = 1, size(final_energy)
                            write(stdout, '(1X,"Final energy estimate for state",1X,'//int_fmt(i)//',":",g25.14)') &
                                i, final_energy(i)
                        end do
                    end if
                end if
            else if(tRPA_QBA) then
                call RunRPA_QBA(WeightDum, EnerDum)
                write(stdout, *) "Summed approx E(Beta)=", EnerDum
            else if(tKP_FCIQMC) then
                if(tExcitedStateKP) then
                    call perform_subspace_fciqmc(kp)
                else
                    call perform_kp_fciqmc(kp)
                end if
            else if(tRPA_QBA) then
                call RunRPA_QBA(WeightDum, EnerDum)
                write(stdout, *) "Summed approx E(Beta)=", EnerDum
            else if(tKP_FCIQMC) then
                if(tExcitedStateKP) then
                    call perform_subspace_fciqmc(kp)
                else
                    call perform_kp_fciqmc(kp)
                end if
            else if(t_real_time_fciqmc) then
                call perform_real_time_fciqmc()
            end if
            IF(TMONTE .and. .not. tMP2Standalone) THEN
!             DBRAT=0.01
!             DBETA=DBRAT*BETA
                write(stdout, *) "I_HMAX:", I_HMAX
                write(stdout, *) "Calculating MC Energy..."
                CALL neci_flush(stdout)
                IF(NTAY(1) > 0) THEN
                    write(stdout, *) "Using approx RHOs generated on the fly, NTAY=", NTAY(1)
!C.. NMAX is now ARR
                    call stop_all(this_routine, "DMONTECARLO2 is now non-functional.")
                else if(NTAY(1) == 0) THEN
                    IF(TENERGY) THEN
                        write(stdout, *) "Using exact RHOs generated on the fly"
!C.. NTAY=0 signifying we're going to calculate the RHO values when we
!C.. need them from the list of eigenvalues.
!C.. Hide NMSH=NEVAL
!C..         FCK=W
!C..         ZIA=CK
!C..         UMAT=NDET
!C..         ALAT=NMRKS
!C..         NMAX=ARR
                        call stop_all(this_routine, "DMONTECARLO2 is now non-functional.")
!                   EN=DMONTECARLO2(MCDET,I_P,BETA,DBETA,I_HMAX,I_VMAX,IMCSTEPS,             &
!     &                G1,NEL,NBASISMAX,nBasis,BRR,IEQSTEPS,                                 &
!     &                NEVAL,W,CK,ARR,NMRKS,NDET,NTAY,RHOEPS,NWHTAY,ILOGGING,ECORE,BETAEQ)
                    ELSE
                        call stop_all(this_routine, "TENERGY not set, but NTAY=0")
                    end if
                end if
                write(stdout, *) "MC Energy:", EN
!CC           write(12,*) DBRAT,EN
            end if
        end if
!C.. /AJWT
    End Subroutine CalcDoCalc