job_fork Subroutine

public subroutine job_fork(n_ensembles)

FIXME : Add documentation We need to set this for the group proc0, as it is previously only set for the global proc0

Arguments

Type IntentOptional Attributes Name
integer, intent(in), optional :: n_ensembles

Contents

Source Code


Source Code

  subroutine job_fork (n_ensembles)
    use file_utils, only: list_name, run_name, init_job_name
    use file_utils, only: init_error_unit, init_input_unit, list_name
    use file_utils, only: futils_initialized => initialized
    use constants, only: run_name_size
    use mp, only: job, proc0, nproc, init_jobs, broadcast, finish_mp
    implicit none
    integer, intent (in), optional :: n_ensembles
    integer, dimension(:), allocatable :: group0
    integer :: i, l, list_unit, ierr
    character(run_name_size), dimension(:), allocatable :: job_list
    logical :: list_mode
    list_mode = .not. present(n_ensembles)

    ! open file containing list of input files to run and read total
    ! number of input files from first line
    if (list_mode) then
       if (proc0) then
          open (newunit = list_unit, file = trim(list_name))
          read (list_unit, *) njobs
       end if
    else
       njobs = n_ensembles
    end if
    call broadcast (njobs)

    if (nproc < njobs) then
       if (proc0) then
          write (*,*) 
          write (*,*) 'Number of jobs = ',njobs,' and number of processors = ',nproc
          write (*,*) 'Number of processors must not be less than the number of jobs'
          write (*,*) 'Stopping'
          write (*,*) 
       end if
       call finish_mp !Ok as all procs call this routine
       stop 
    end if
       
    if (mod(nproc, njobs) /= 0) then
       if (proc0) then
          write (*,*) 
          write (*,*) 'Number of jobs = ',njobs,' and number of processors = ',nproc
          write (*,*) 'Number of jobs must evenly divide the number of processors.'
          write (*,*) 'Stopping'
          write (*,*) 
       end if
       call finish_mp !Ok as all procs call this routine
       stop
    end if
       
    allocate (job_list(0:njobs-1))
       
    if (proc0) then
       if (list_mode) then
          do i = 0, njobs - 1
             read (list_unit, fmt="(a)") job_list(i)
          end do
          close (list_unit)
       else
          l = len_trim(list_name)
          do i = 0, njobs - 1
             write(job_list(i),'(A,"_",I0)') list_name(1:l-3), i + 1
          end do
       end if
    end if
    
    call broadcast(job_list)
    
    allocate (group0(0:njobs-1))
    
    call init_jobs (njobs, group0, ierr)
    call init_job_name (job_list(job))
    
    if (proc0) then
       call init_error_unit(.true.)
       call init_input_unit(.true.)
    end if

    if (nproc > 1 .and. proc0) &
         & write(*,*) 'Job ',job,' is called ',trim(run_name),&
         & ' and is running on ',nproc,' processors'
    if (nproc == 1) write(*,*) 'Job ',job,' is called ',trim(run_name),&
         & ' and is running on ',nproc,' processor'
    
    deallocate (group0, job_list)

    !> We need to set this for the group proc0, as it is previously
    !> only set for the global proc0
    if (proc0) futils_initialized = .true.
  end subroutine job_fork