WriteTMat Subroutine

public subroutine WriteTMat(NBASIS)

Arguments

Type IntentOptional Attributes Name
integer :: NBASIS

Contents

Source Code


Source Code

    SUBROUTINE WriteTMat(NBASIS)
        ! In:
        !    nBasis: size of basis (# orbitals).
        IMPLICIT NONE
        INTEGER II, I, J, NBASIS, iunit

        iunit = get_free_unit()
        open(iunit, file="TMATSYMLABEL", status="unknown")
        IF (associated(SYMLABELINTSCUM)) THEN
            write(iunit, *) "SYMLABELCOUNTS,SYMLABELCOUNTSCUM,SYMLABELINTSCUM:"
            DO I = 1, NSYMLABELS
                write(iunit, "(I5)", advance='no') SYMLABELCOUNTS(2, I)
                CALL neci_flush(iunit)
            end do
            write(iunit, *) ""
            DO I = 1, NSYMLABELS
                write(iunit, "(I5)", advance='no') SYMLABELCOUNTSCUM(I)
                CALL neci_flush(iunit)
            end do
            write(iunit, *) ""
            DO I = 1, NSYMLABELS
                write(iunit, "(I5)", advance='no') SYMLABELINTSCUM(I)
                CALL neci_flush(iunit)
            end do
            write(iunit, *) ""
            write(iunit, *) "**********************************"
        end if
        IF (associated(SYMLABELINTSCUM2)) THEN
            write(iunit, *) "SYMLABELCOUNTS,SYMLABELCOUNTSCUM2,SYMLABELINTSCUM2:"
            DO I = 1, NSYMLABELS
                write(iunit, "(I5)", advance='no') SYMLABELCOUNTS(2, I)
                CALL neci_flush(iunit)
            end do
            write(iunit, *) ""
            DO I = 1, NSYMLABELS
                write(iunit, "(I5)", advance='no') SYMLABELCOUNTSCUM2(I)
                CALL neci_flush(iunit)
            end do
            write(iunit, *) ""
            DO I = 1, NSYMLABELS
                write(iunit, "(I5)", advance='no') SYMLABELINTSCUM2(I)
                CALL neci_flush(iunit)
            end do
            write(iunit, *) ""
            write(iunit, *) "**********************************"
            CALL neci_flush(iunit)
        end if
        write(iunit, *) "TMAT:"
        DO I = 1, NBASIS, 2
            DO J = 1, NBASIS, 2
                write(iunit, *) (I + 1) / 2, (J + 1) / 2, GetTMATEl(I, J)
            end do
        end do
        write(iunit, *) "**********************************"
        CALL neci_flush(iunit)
        IF (ASSOCIated(TMATSYM2) .or. ASSOCIated(TMAT2D2)) THEN
            write(iunit, *) "TMAT2:"
            DO II = 1, NSYMLABELS
                DO I = SYMLABELCOUNTSCUM(II - 1) + 1, SYMLABELCOUNTSCUM(II)
                    DO J = SYMLABELCOUNTSCUM(II - 1) + 1, I
                        write(iunit, *) I, J, GetNEWTMATEl((2 * I), (2 * J))
                        CALL neci_flush(iunit)
                    end do
                end do
            end do
        end if
        write(iunit, *) "*********************************"
        write(iunit, *) "*********************************"
        CALL neci_flush(iunit)
    END SUBROUTINE WriteTMat