tem_open_distconf_array Subroutine

public subroutine tem_open_distconf_array(L, fileName, proc)

Open an array of Lua handles.

This is a drop in replacement for open_config_file from Aotus and allows the scalable processing of Lua files, as they are read by a single process and then streamed to all in proc. There should be no restrictions on the Lua scripts themselves in this method, as it uses an overloading of the require mechanism in Lua itself to replace the file searches by lookups of buffered Lua code snippets. The execution of the Lua script itself is not changed.

This variant of the routine opens an array of handles with the same script. It is used to provide individual Lua states, that can be used independently later on, for example in the evaluation of Lua functions for boundary conditions.

Arguments

Type IntentOptional Attributes Name
type(flu_State) :: L(:)
character(len=*), intent(in) :: fileName
type(tem_comm_env_type) :: proc

Source Code

  subroutine tem_open_distconf_array(L, fileName, proc)
    ! -------------------------------------------------------------------- !
    type(flu_State) :: L(:) !< Opened Lua state with the loaded script.
    character(len=*), intent(in) :: fileName !< Name of the file to open.
    type(tem_comm_env_type) :: proc !< Process description to use.
    ! -------------------------------------------------------------------- !
    type(cbuf_type) :: scriptbuf
    type(cbuf_type) :: modbuf
    integer :: iError
    integer :: comm
    integer :: nProcs
    integer :: nFiles
    integer :: nLuaStates
    integer :: bufsize
    integer :: iFile
    integer :: iState
    integer :: Lua_lb
    character(len=labelLen), allocatable :: req_label(:)
    character(len=pathLen), allocatable  :: req_file(:)
    ! -------------------------------------------------------------------- !

    nLuaStates = size(L)

    comm = proc%comm
    nProcs = proc%comm_size

    if ( proc%isRoot ) then
      Lua_lb = 2
    else
      Lua_lb = 1
    end if

    if (nProcs > 1) then
      nFiles = 0

      if ( proc%isRoot ) then
        ! Only rank 0 reads and executes the config file for the first Lua
        ! state, while doing so, it keeps track of all the required files.
        call tem_require_track_rq(L(1))
        call open_config_file(L(1), trim(filename), buffer=scriptbuf)
        call tem_get_required_Lua( L(1), fileList = req_file, &
          &                        labelList = req_label      )
        nFiles = size(req_Label)
      end if
      ! Open the configuration on all other processes and the remaining local
      ! Lua states with the rq_store loaded:
      do iState=Lua_lb,nLuaStates
        call tem_require_rq_store(L(iState))
      end do

      ! Broadcast the number of required files
      ! MPI_BCAST(BUFFER, COUNT, DATATYPE, ROOT, COMM, IERROR)
      call MPI_Bcast(nFiles, 1, MPI_INTEGER, 0, comm, iError)

      if ( .not. proc%isRoot ) allocate(req_label(nFiles))
      if ( .not. proc%isRoot ) allocate(req_file(nFiles))

      ! Broadcast the module names
      call MPI_Bcast( req_label, nFiles*labelLen, MPI_CHARACTER, 0, &
        &             comm, iError                                  )
      ! Broadcast the file names
      call MPI_Bcast( req_file, nFiles*pathLen, MPI_CHARACTER, 0, &
        &             comm, iError                                )

      ! Now go on opening all required files
      do iFile=1,nFiles
        if (proc%isRoot) then
          call tem_pop_from_track_rq(L(1), trim(req_label(iFile)), modbuf)
          bufsize = size(modbuf%buffer)
        end if
        ! Broadcast the loaded script to all processes.
        ! MPI_BCAST(BUFFER, COUNT, DATATYPE, ROOT, COMM, IERROR)
        call MPI_Bcast(bufsize, 1, MPI_INTEGER, 0, comm, iError)
        if (.not. proc%isRoot) allocate(modbuf%buffer(bufsize))
        call MPI_Bcast(modbuf%buffer, bufsize, MPI_CHARACTER, 0, comm, iError)
        do iState=Lua_lb,nLuaStates
          call tem_push_to_rq_store( L(iState),                         &
            &                        modname  = trim(req_label(iFile)), &
            &                        filename = trim(req_file(iFile)),  &
            &                        buffer   = modbuf%buffer           )
        end do
        if (proc%isRoot) then
          call flu_free_cbuf(modbuf)
        else
          deallocate(modbuf%buffer)
        end if
      end do

      ! Broadcast the loaded script to all processes.
      if ( proc%isRoot ) bufsize = size(scriptbuf%buffer)
      ! MPI_BCAST(BUFFER, COUNT, DATATYPE, ROOT, COMM, IERROR)
      call MPI_Bcast(bufsize, 1, MPI_INTEGER, 0, comm, iError)
      if ( .not. proc%isRoot ) allocate(scriptbuf%buffer(bufsize))
      call MPI_Bcast(scriptbuf%buffer, bufsize, MPI_CHARACTER, 0, comm, iError)

      do iState=Lua_lb,nLuaStates
        call open_config_buffer(L = L(iState), buffer = scriptbuf%buffer)
      end do
      if ( proc%isRoot ) then
        call flu_free_cbuf(scriptbuf)
      else
        deallocate(scriptbuf%buffer)
      end if

    else

      ! Only a single process, no need for broadcasting.
      do iState=1,nLuaStates
        call open_config_file(L = L(iState), filename = trim(fileName))
      end do

    end if

  end subroutine tem_open_distconf_array