subroutine trmpi_requestor(zsvc,zargs)

  ! TRANSP MPI -- cpu 0 broadcast request to cpu ranks > 0 that are waiting
  !   SEE ALSO: subroutine trmpi_listener

  !   MOD DMC May 2011: in case of directory creation, invoke the cpu 0
  !   participation here (mpi_mkdir call)

  use mpi_proc_data
  use trmpi
  use logmod
  implicit NONE

  character*(*), intent(in) :: zsvc  ! name of service 
  ! NOTE: 16 char limit, alphanumeric characters, no imbedded blanks
  ! converted to UPPERCASE prior to transmission

  character*(*), intent(in) :: zargs ! service arguments
  ! 184 character limit at present...

  !-------------------------------

  character*200 :: chbuf  ! 1st 16 chars: service name; last 184 chars: args

  character*39 :: svc_legal = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-$'

  integer      :: iertmp, grp_rank 
  integer      :: ierr777=777
  logical      :: is_mpi

  !-------------------------------

  call trmpi_check('trmpi_requestor')

  if(trmpi_myid.ne.0) then
     call mpi_proc_info(trmpi_comm,iertmp,myproc=grp_rank)
     if (iertmp .ne. 0 .and. grp_rank .ne. 0) then 
        call errmsg_exit(' ?trmpi_requestor -- to be called by rank 0 cpu ONLY!')
     endif
  endif

  call enterLog("trmpi_requestor")  ! all returns through exitLog()

  if (isOpenLog()) then
     call warnLog("trmpi_requestor: service  = "//trim(zsvc))
     if (len_trim(zargs)>0) then
        call warnLog("trmpi_requestor: argument = "//trim(zargs))
     end if
  end if

  ! 03/19/2013: CLF check if mpi
  if ( zsvc(1:1) .eq. '!' ) then
     chbuf(1:16) = zsvc(2:)
     is_mpi=.false.
  else
     chbuf(1:16) = zsvc
     is_mpi=.true.
  endif
  call uupper(chbuf(1:16))

  call trmpi_syntax(trim(chbuf(1:16)),svc_legal, &
       'trmpi_requestor','service name')

  chbuf(17:) = zargs

#ifdef __MPI

  ! broadcast
  ! 03/19/2013 CLF: Only broadcast if module is mpi
if (is_mpi) then
  call infoLog('trmpi_requestor: call MPI_BCAST (cpu0):trim(chbuf)'// &
       ' comm=',trmpi_comm) 
  call MPI_BCAST(chbuf, 200, MPI_CHARACTER, 0, trmpi_comm, iertmp)
  if(iertmp.ne.0) then
     write(trmpi_lunmsg,*) ' ?trmpi_requestor: MPI_BCAST status=',iertmp, &
          ' on cpu# ',trmpi_myid, 'group =',trmpi_comm
     call MPI_ABORT(trmpi_comm,iertmp,ierr777)
     call bad_exit
#ifdef _DEBUG
  else
    ! RGA, excessive messages especially when running pt_solver
     write(trmpi_lunmsg,*) ' '
     write(trmpi_lunmsg,*) &
          ' trmpi_requestor broadcast (cpu0): '//trim(zsvc)//' '// &
          ' trmpi_comm =',trmpi_comm,' '// &
          trim(zargs)
     write(trmpi_lunmsg,*) ' '
#endif
  endif
  ! 07/22/2011 CLF: synch
   call infoLog(' trmpi_requestor: call MPI_BARRIER (cpu0): ' // &
       trim(chbuf)//' comm=',trmpi_comm)
  call MPI_BARRIER(trmpi_comm, iertmp)
  if(iertmp.ne.0) then
     write(trmpi_lunmsg,*) '?trmpi_requestor: MPI_BARRIER error detected!'
     call MPI_ABORT(trmpi_comm,iertmp,ierr777)
     call bad_exit
  endif
endif

#endif

  if(chbuf(1:16).eq.'CREATE_SUBDIR   ') then

     !  trmpi_comm OK, even in a serial job
     call enterLog("CREATE_SUBDIR: "//trim(zargs)) 

     call mpi_mkdir(trmpi_comm,zargs,iertmp,clean=.TRUE.)
     if(iertmp.ne.0) then
        write(trmpi_lunmsg,*) ' '
        write(trmpi_lunmsg,*) &
             ' trmpi_requestor "mpi_mkdir" '//trim(zargs)
        write(trmpi_lunmsg,*) ' participation error (cpu 0) ier=',iertmp
        write(trmpi_lunmsg,*) ' '
#ifdef __MPI
        call MPI_ABORT(trmpi_comm,iertmp,ierr777)
#endif
        call bad_exit
     endif
     call exitLog("CREATE_SUBDIR") 
  endif

  if(chbuf(1:16).eq.'CHECK_SUBDIR   ') then

     !  trmpi_comm OK, even in a serial job
     call enterLog("CHECK_SUBDIR: "//trim(zargs)) 

     call mpi_mkdir(trmpi_comm,zargs,iertmp,clean=.FALSE.)
     if(iertmp.ne.0) then
        write(trmpi_lunmsg,*) ' '
        write(trmpi_lunmsg,*) &
             ' trmpi_requestor "mpi_mkdir" '//trim(zargs)
        write(trmpi_lunmsg,*) ' participation error (cpu 0) ier=',iertmp
        write(trmpi_lunmsg,*) ' '
#ifdef __MPI
        call MPI_ABORT(trmpi_comm,iertmp,ierr777)
#endif
        call bad_exit
     endif
     call exitLog("CHECK_SUBDIR") 
  endif

  if(chbuf(1:16).eq.'CHANGE_DIRECTORY') then

     !  change directory (all ranks)

     call sset_cwd(trim(zargs),iertmp)
     if(iertmp.ne.0) then
        write(trmpi_lunmsg,*) ' '
        write(trmpi_lunmsg,*) &
             ' trmpi_requestor "CHANGE_DIRECTORY" '//trim(zargs)
        write(trmpi_lunmsg,*) ' participation error (cpu 0) ier=',iertmp
        write(trmpi_lunmsg,*) ' '

        call bad_exit
     endif
  endif

  if(chbuf(1:16).eq.'BROADCAST_FILE  ') then

     call enterLog("BROADCAST_FILE: "//trim(zargs)) 
     call mpi_file_bcast(trmpi_comm,zargs,iertmp)
     if(iertmp.ne.0) then
        write(trmpi_lunmsg,*) ' '
        write(trmpi_lunmsg,*) &
             ' trmpi_requestor "mpi_file_bcast" '//trim(zargs)
        write(trmpi_lunmsg,*) ' participation error (cpu 0) ier =',iertmp
        write(trmpi_lunmsg,*) ' '
#ifdef __MPI
        call MPI_ABORT(trmpi_comm,iertmp,ierr777)
#endif
        call bad_exit
     endif
     call exitLog("BROADCAST_FILE") 

  endif

  if(chbuf(1:16).eq.'FILE_OPEN_READ  ') then
     ! expect zargs to have form <lun>,<filename>
     ! file must exist

     call trmpi_file_open_read(zargs)

  endif

  if(chbuf(1:16).eq.'FILE_CLOSE     ') then
     ! zargs to contain an ascii encoded <lun> only.

     call trmpi_file_close(zargs)

  endif

  call exitLog("trmpi_requestor")

end subroutine trmpi_requestor
