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, num_sect_diag_grids, 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            :: 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_H_in, xdr_T_in, xdr_amp_out
  logical, save            :: uniform_e_grid
  logical, save            :: jpi_coupling
  integer, save            :: start_mesh

  logical, save            :: farm_format  
! if true, all H files have the farm/H.dat (Berrington et al Rmatrix1, CPC 92 (1995) 290-420 page 372 section 5.6) format
! this means that kschl is undefined and k-splitting for Jpi coupling is not possible 
  logical, save            :: molecule_format
! ie input comes from UKRmol in farm_format with packed (non-zero) lr coefficients 
  logical, save            :: packed_cf
! packed non-zero lr coefficients
  logical, save            :: large_wmat
! read in wmat line by line as loc; tmpwm(1:nc,loc), default for XDR format
  integer, save            :: nphys     ! number of 'physical' target states to be retained
!    nphys only work in farm_format = .true. for the moment
  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_H_in, xdr_T_in, xdr_amp_out, split_prop, uniform_e_grid, jpi_coupling
  public bug1, bug2, bug3, bug4, bug5, bug6, bug7, bug8, bug9
  public farm_format, nphys, molecule_format, packed_cf, large_wmat

contains

  subroutine rd_nmlst
! parameters required only in the propagation stage:
    integer                  :: num_rm_gen, num_asy_per_pipe
    integer                  :: np_rm_gather_max
    logical                  :: rm_group_factor
    integer                  :: np_managers
    integer                  :: ne_write, ng, nxsn_store
    integer                  :: time_limit, num_timers_prop
    character(40)            :: tname_prop(30), tname_dig(10)
    integer                  :: nts_save, nt
    integer                  :: xsn_list(100)
!    real(wp)                 :: ewron, eps
    real(wp)                 :: eps
    logical                  :: buttle, partitioned
    integer                  :: newbut
    logical                  :: gail_exp
    logical                  :: xdr_amp_in
    character(len=20)        :: flabel_prop
    logical                  :: spec_gail_exp
    integer                  :: ios, ctxt, debug(9)
    integer                  :: i_large_wmat
! 0 normally, set as size of sub-vector for division of 1:ns in copies or read-in of wmat
    logical                  :: full_km, full_tm, km_form, tm_form, kt_header
! needed for rmprop: choice of full k(t)-matrix output, formatted or unformatted
    integer                  :: drop_tol_num  ! -drop_tol_num /rafin is the limit for keeping closed channels
    integer                  :: num_pipe_grps  !The number of I/O master pipelines during propagation phase
! 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, &
         xdr_H_in, xdr_T_in, xdr_amp_out, debug,          & 
         jpi_coupling, tname_dig,           &           
         farm_format, nphys, molecule_format, packed_cf, large_wmat, &
! Input variables not used in diag stage (exclusive to prop stage)       
         num_rm_gen, buttle, newbut, partitioned, nxsn_store, xsn_list, ne_write, & 
         nts_save, time_limit, eps, ng, nt, tdfn, gail_exp, num_asy_per_pipe, &
         num_timers_prop, tname_prop, flabel_prop, np_rm_gather_max, &
         rm_group_factor, np_managers, xdr_amp_in, spec_gail_exp, &
         i_large_wmat, full_km, full_tm, km_form, tm_form, kt_header, &
         drop_tol_num, num_pipe_grps

! default values
    farm_format = .false.
    molecule_format = .false.
    packed_cf = .false.
    large_wmat = .false.
    nphys = 0
    drop_tol_num = 4.0_wp
    split_prop = .false.
    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_H_in = .true.
    xdr_T_in = .true.
    xdr_amp_out = .true.
    ! AGS serial version
!    num_sect_diag_grids = 1
    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) STOP
    read (nfnml, phzin, iostat=ios)
    if (ios /= 0) then
       write (fo, phzin)
       STOP
    end if
    close (nfnml)

    if (molecule_format) then
! UKRmol presents farm data with packed lrp coefs, 
! jpi_coupling is needed to avoid symmetry assumptions in setting up the lrp
       farm_format = .true.
       packed_cf = .true.
! molecular safety assignment no longer needed, we hope:
!       jpi_coupling = .true.
       xdr_H_in = .false.    ! until XDR is introduced to UKRmol 
    end if
! farm_format restriction:
    if (farm_format .and. jpi_coupling) then
       split_prop = .false.
       write (fo,'(a)') 'Farm binary format has been chosen: propagator  k-splitting is not yet possible in this case'
    end if 
    if (.not. farm_format) large_wmat = .true.
! ie large_wmat needs to be set actively if farm_format is set true
 
    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)
    bug9 = 1

! 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 in atomic case (UKRmol has strange combinations)
    if (.not. molecule_format) then
       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
    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)
      if (farm_format) then 
         write (fo,'(a)') 'Farm format: lrp coefs included in H file (ie target moments not used)'
      else
         write (fo,'(a)') 'Target Moment File: ' // TRIM(fltm)
      end if
      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
