module rmX1_in
! read data defining pdiag run
! Time-stamp: "2005-07-28 09:55:40 cjn"
! modified for jpi_coupling april to dec 2006 vmb
  use precisn, only: wp
  use io_units, only: nfnml, fo
  use mpi_params, only: io_processor
!  use blacs, only: p, q, nblock, ictxt, io_processor
  implicit none

  integer, save            :: bug1, bug2, bug3, bug4, bug5
  integer, save            :: bug6, bug7, bug8, bug9
  integer, save            :: lrgl1, nspn1, npty1
  integer, save            :: num_timers_dig
  integer, save            :: p,q, nblock
  integer, save            :: n_lambda, nhmax, ncmax
  real(wp), save           :: abvthr, belthr, degeny, rafin
  integer, save            :: ne(10)
  real(wp), save           :: esc(21)
  real(wp), save           :: einc_fine, einc_coarse
  real(wp), save           :: emax
  logical, save            :: split_prop
  real(wp), save           :: tdfn(50)
  real(wp), pointer, save  :: tconst(:)
  character(len=20), save  :: flabel_dig
  character(len=80),save   :: title
  character(len=120), save :: filh, fltm
  integer, save            :: dflag(5), pflg(5)
  integer, save            :: targ_low_sce, targ_high_sce
  integer, save            :: nz, nelc    
  logical, save            :: inc_lrp_prop
  logical, save            :: xdr
  logical, save            :: uniform_e_grid
  logical, save            :: jpi_coupling
  integer, save            :: start_mesh

  private
  public rd_nmlst
  public lrgl1, nspn1, npty1, n_lambda, nhmax, ncmax
  public abvthr, belthr, degeny, rafin, ne, esc, einc_fine
  public einc_coarse, emax, tdfn, tconst, flabel_dig, title, filh
  public fltm, dflag, pflg, targ_low_sce, targ_high_sce, start_mesh
  public inc_lrp_prop, xdr, split_prop, uniform_e_grid, jpi_coupling
  public bug1, bug2, bug3, bug4, bug5, bug6, bug7, bug8, bug9

contains

  subroutine rd_nmlst
! parameters required only in the propagation stage:
    integer                  :: num_rm_gen, num_asy_per_pipe
    integer                  :: ne_write, nc2, ng, nxsn_store
    integer                  :: time_limit, num_timers_prop
    integer                  :: nts_save, nt
    integer                  :: xsn_list(100)
    real(wp)                 :: ewron, eps
    logical                  :: buttle
    logical                  :: gail_exp
    character(len=20)        :: flabel_prop
    integer                  :: ios, ctxt, debug(9)

! Input variables used in diag stage:
    namelist /phzin/ title, dflag, pflg, einc_fine, nz, nelc,    &
         einc_coarse, emax, targ_low_sce, targ_high_sce,         &
         abvthr, belthr, degeny, nhmax, ncmax, filh, start_mesh, &
         fltm, nspn1, npty1, lrgl1, n_lambda, uniform_e_grid,    &
         split_prop, inc_lrp_prop, rafin, num_timers_dig,        &
         ne, esc, flabel_dig, p, q, nblock, xdr, debug,          & 
         jpi_coupling,                                           &           
! Input variables used in prop stage                             
         num_rm_gen, buttle, nxsn_store, xsn_list,               &
         ne_write, nts_save, time_limit, eps, ng, nt,            &
         tdfn, gail_exp, num_asy_per_pipe,                       &
         num_timers_prop, flabel_prop

! default values
    split_prop = .true.
    inc_lrp_prop = .true.
    targ_low_sce = 0
    targ_high_sce = 0
    einc_fine = 0.00002_wp
    einc_coarse = 0.01_wp
    emax = 1.86_wp
    nhmax = 8000
    ncmax = 315
    ne = 0
    esc= 0.0_wp
    title = REPEAT(' ',80)
    filh  = REPEAT(' ',120)
    filh = 'H'
    fltm = 'TARMOM'
    abvthr = 1.0e-3_wp
    belthr = 1.0e-3_wp
    degeny = 1.0e-06_wp
    npty1 = -1 !L pi must be input
    rafin = -1.0_wp
    n_lambda = 2
    flabel_dig = 'DIG'
    num_timers_dig = 4
    xdr = .true.
    debug = 0
    uniform_e_grid = .false.
    start_mesh = 1
    jpi_coupling = .false. !default to LS coupling

    open (unit=nfnml, file = 'phzin.ctl', status='old', &
         position = 'rewind', iostat= ios)
    if (ios /= 0) then
       write (fo,'(a)') " phzin.ctl file not found - aborting "
       STOP
    end if
    read (nfnml, phzin, iostat=ios)
    if (ios /= 0) then
       write (fo,'(a,i6)') " Problem with Namelist file - aborting ",ios
       write (fo, phzin)
       STOP
    end if
    close (nfnml)

    bug1 = debug(1); bug2 = debug(2); bug3 = debug(3); bug4 = debug(4)
    bug5 = debug(5); bug6 = debug(6); bug7 = debug(7); bug8 = debug(8)
    bug9 = debug(9)

! Rules set by the rmatr2/95 interface and enforced in rmx and prm
!  Exchange runs:
!   In LS coupling:
!    lrgl1 = total angular momentum L 
!    nspn1 = total multiplicity S
!   In jpi coupling:
!    lrgl1 = 2*J
!    nspn1 = 0
!  No_exchange runs:
!   In LS coupling:
!    lrgl1 = total angular momentum L 
!    nspn1 = -target multiplicity Si
!   In jpi coupling:
!    lrgl1 = -2*K
!    nspn1 = 1 weighting factor for lowest K
!          = 2 weighting factor for other K

    if (jpi_coupling) nspn1=0 !until specified by interface data

! Test for no-exchange files
    if (jpi_coupling) then
       if (MOD(nelc+lrgl1,2)==0) lrgl1=-ABS(lrgl1) !lrgl1 has been input as 2*K 
    else
       if (MOD(nelc+nspn1,2)==1) nspn1=-ABS(nspn1) !nspn1 is target multiplicity
    end if
! print basic input data or complete namelist phzin if diaflg(1) set

    if(io_processor) then
      call prt_title
      write (fo,'(a,2es14.6)') 'Threshold zone, abvthr, belthr = ', &
         abvthr, belthr
      write (fo,'(a)') 'H-file: ' // TRIM(filh)
      write (fo,'(a)') 'Target Moment File: ' // TRIM(fltm)
      write (fo,'(/)')
      if (dflag(2) > 0) write (fo,phzin)
    end if
  end subroutine rd_nmlst

  subroutine prt_title
! write a general title indicating the target ion/atom,
! # continuum electrons, highest electron energy
    character(len=2), parameter    :: atom(57) = (/ &
         ' H', 'He', 'Li', 'Be', ' B', ' C', ' N', ' O', ' F', &
         'Ne', 'Na', 'Mg', 'Al', 'Si', ' P', ' S', 'Cl', 'Ar', &
         ' K', 'Ca', 'Sc', 'Ti', ' V', 'Cr', 'Mn', 'Fe', 'Co', &
         'Ni', 'Cu', 'Zn', 'Ga', 'Ge', 'As', 'Se', 'Br', 'Kr', &
         'Rb', 'Sr', ' Y', 'Zr', 'Nb', 'Mo', 'Tc', 'Ru', 'Rh', &
         'Pd', 'Ag', 'Cd', 'In', 'Sn', 'Sb', 'Te', ' I', 'Xe', &
         'Cs', 'Ba', 'La'/)
    character(len=1)                :: chrge
    character(len=8)                :: today
    character(len=10)               :: now
    integer                         :: nzeff

    call date_and_time (today, now)
! today: ccyymmdd
    write (fo,'(a,a2,a,a2,a,a4)') 'Job run on ', today(7:8), &
         '/', today(5:6), '/', today(1:4)
! now: hhmmss.sss
    write (fo,'(a,a2,a,a2,a,a5)') 'Time: ', now(1:2), ':', &
         now(3:4), ':', now(5:10)

    nzeff = nz - nelc
    if (nzeff > 0) then
       chrge = '+'
    else if (nzeff < 0) then
       chrge = '-'
       nzeff = - nzeff
    end if

    if (nzeff > 1) then
       write (fo,'(5x,37("*"))')
       write (fo,'(5x,"*",35x,"*")')
       if (nzeff < 10) then
          write (fo,'(5x,"*",29x,i1,a1,4x,"*")') nzeff, chrge
       else
          write (fo,'(5x,"*",29x,i2,a1,3x,"*")') nzeff, chrge
       end if

       if (nz > 57) then
          write (fo,'(5x,"*",4x,a,i4,6x,"*")') 'Electron scatter&
               &ing by Z = ', nz
       else
          write (fo,'(5x,"*",4x,a,a2,6x,"*")') 'Electron scatter&
               &ing by ', atom(nz)
       end if
       write (fo,'(5x,"*",35x,"*")')
       write (fo,'(5x,37("*"))')
    else
       write (fo,'(/,5x,37("*"))')
       write (fo,'(5x,"*",35x,"*")')
       if (nzeff == 1) write (fo,'(5x,"*",29x,a1,5x,"*")') chrge
       if (nz > 57) then
          write (fo,'(5x,"*",4x,a,i4,6x,"*")') 'Electron scatter&
               &ing by Z = ', nz
       else
          write (fo,'(5x,"*",4x,a,a2,6x,"*")') 'Electron scattering by ',&
               atom(nz)
       end if
       write (fo,'(5x,"*",35x,"*")')
       write (fo,'(5x,37("*"),/)')
    end if
    if (title /= ' ') write (fo,'(/,a,/)') TRIM(title)
  end subroutine prt_title

end module rmX1_in
