write_trial_space Subroutine

public subroutine write_trial_space()

Uses

Arguments

None

Contents

Source Code


Source Code

    subroutine write_trial_space()

        use FciMCData, only: trial_space, trial_space_size

        integer :: i, j, k, iunit, ierr
        logical :: texist
        character(len=*), parameter :: t_r = 'write_trial_space'

        write(stdout, '("Writing the trial space to a file...")');
        iunit = get_free_unit()

        ! Let each processor write its trial states to the file. Each processor waits for
        ! the processor before it to finish before starting.
        do i = 0, nProcessors - 1

            if (iProcIndex == i) then

                if (i == 0) then
                    open(iunit, file='TRIALSPACE', status='replace')
                else
                    inquire (file='TRIALSPACE', exist=texist)
                    if (.not. texist) call stop_all(t_r, '"TRIALSPACE" file not found')
                    open(iunit, file='TRIALSPACE', status='old', position='append')
                end if

                do j = 1, trial_space_size
                    do k = 0, nifd
                        write(iunit, '(i24)', advance='no') trial_space(k, j)
                    end do
                    write(iunit, *)
                end do

                close(iunit)

            end if

            call MPIBarrier(ierr)

            if (i == 0) call MPIBCast(iunit, 0)

        end do

    end subroutine write_trial_space