helena_assign_code_parameters.f90

Go to the documentation of this file.

subroutine helena_assign_code_parameters(code_parameters, return_status)

!-----------------------------------------------------------------------
! calls the XML parser for the code parameters and assign the
! resulting values to the corresponding variables
!TODO: check an alternative and more elegant solution in Perl
!-----------------------------------------------------------------------
  
  use itm_types
  use mod_dat
  use mod_dete
  use mod_map
  use mod_mesh
  use mod_meshacc
  use mod_output
  use mod_profiles
  
  use euitm_schemas
  use euitm_xml_parser  

  implicit none

  integer(itm_i4), parameter :: iu6 = 6

  type (type_param) :: code_parameters
  integer(itm_i4), intent(out) :: return_status 

  type(tree) :: parameter_list
  type(element), pointer :: temp_pointer
  integer(itm_i4) :: nparm, n_values
  character(len = 132) :: cname

  nparm = 0
  n_values = 0
  return_status = 0      ! no error

!-- parse xml-string code_parameters%parameters using W3C XML schema in
!   code_parameters%schema
  call euitm_xml_parse(code_parameters, nparm, parameter_list)

!-- assign variables

  temp_pointer => parameter_list%first

  outer: do
    cname = char2str(temp_pointer%cname)   ! necessary for AIX
    select case (cname)
      case ("parameters")
        temp_pointer => temp_pointer%child
        cycle
!--   profile_parameters
      case ("profile_parameters")
        temp_pointer => temp_pointer%child
        cycle
      case ("input_type")
        if (allocated(temp_pointer%cvalue)) &
         input_type = char2str(temp_pointer%cvalue)
      case ("radial_coordinate")
        if (allocated(temp_pointer%cvalue)) &
         radial_coordinate = char2str(temp_pointer%cvalue)
      case ("hbt")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, hbt)
      case ("current_averaging")
        if (allocated(temp_pointer%cvalue)) &
         current_averaging = char2str(temp_pointer%cvalue)
!--   shape_parameters
      case ("shape_parameters")
        temp_pointer => temp_pointer%child
        cycle
      case ("ellip")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, ellip)
      case ("tria")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, tria)
      case ("quad")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, quad)
      case ("par1")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, par1)
      case ("par2")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, par2)
      case ("par3")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, par3)
      case ("par4")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, par4)
      case ("isol")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, isol)
      case ("ias")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, ias)
      case ("mfm")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, mfm)
      case ("iarc")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, iarc)
      case ("imesh")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, imesh)
      case ("amesh")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, amesh)
      case ("bmesh")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, bmesh)
      case ("n_acc_points")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, n_acc_points)
      case ("s_acc")
        if (allocated(temp_pointer%cvalue)) &
          call scan_str2varnum(char2str(temp_pointer%cvalue), s_acc, n_values)
      case ("sig")
        if (allocated(temp_pointer%cvalue)) &
          call scan_str2varnum(char2str(temp_pointer%cvalue), sig, n_values)
      case ("weights")
        if (allocated(temp_pointer%cvalue)) &
          call scan_str2varnum(char2str(temp_pointer%cvalue), weights, &
          n_values)
      case ("equidistant")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, equidistant)
!--   global_parameters
      case ("global_parameters")
        temp_pointer => temp_pointer%child
        cycle
      case ("match")
        if (allocated(temp_pointer%cvalue)) &
         match = char2str(temp_pointer%cvalue)
      case ("eps")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, eps)
      case ("alfa")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, alfa)
      case ("B")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, b)
      case ("Ip")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, ip)
      case ("q95")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, q95)
      case ("betap")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, betap)
      case ("W_MHD")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, wmhd)
      case ("rvac")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, rvac)
      case ("bvac")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, bvac)
      case ("zeff")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, zeff)
      case ("zn0")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, zn0)
      case ("rpe")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, rpe)
      case ("etaei")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, etaei)
      case ("ne")
        temp_pointer => temp_pointer%child
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, ne%shape)
        temp_pointer => temp_pointer%sibling
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, ne%h)
        temp_pointer => temp_pointer%sibling
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, ne%h_0)
        temp_pointer => temp_pointer%sibling
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, ne%slope)
        temp_pointer => temp_pointer%sibling
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, ne%psi_m)
        temp_pointer => temp_pointer%sibling
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, ne%delta)
        temp_pointer => temp_pointer%sibling
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, ne%psi_0)
        temp_pointer => temp_pointer%sibling
        if (allocated(temp_pointer%cvalue)) &
          call scan_str2num(char2str(temp_pointer%cvalue), ne%alpha, n_values)
      case ("te")
        temp_pointer => temp_pointer%child
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, te%shape)
        temp_pointer => temp_pointer%sibling
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, te%h)
        temp_pointer => temp_pointer%sibling
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, te%h_0)
        temp_pointer => temp_pointer%sibling
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, te%slope)
        temp_pointer => temp_pointer%sibling
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, te%psi_m)
        temp_pointer => temp_pointer%sibling
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, te%delta)
        temp_pointer => temp_pointer%sibling
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, te%psi_0)
        temp_pointer => temp_pointer%sibling
        if (allocated(temp_pointer%cvalue)) &
          call scan_str2num(char2str(temp_pointer%cvalue), te%alpha, n_values)
      case ("cpsurfin")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, cpsurfin)
!--   numerical_parameters
      case ("numerical_parameters")
        temp_pointer => temp_pointer%child
        cycle
      case ("nr")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, nr)
      case ("np")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, np)
      case ("nrmap")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, nrmap)
      case ("npmap")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, npmap)
      case ("nchi")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, nchi)
      case ("niter")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, niter)
      case ("nmesh")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, nmesh)
      case ("nouter")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, nouter)
      case ("amix")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, amix)
      case ("errit")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, errit)
      case ("errcur")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, errcur)
      case ("nbb")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, nbb)
      case ("abb")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, abb)
      case ("bbb")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, bbb)
      case ("ampl")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, ampl)
!--   diagnostics_parameters
      case ("diagnostics_parameters")
        temp_pointer => temp_pointer%child
        cycle
      case ("verbosity")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, verbosity)
      case ("output")
        if (allocated(temp_pointer%cvalue)) &
         output = char2str(temp_pointer%cvalue)
      case ("diagnostics_on")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, diagnostics_on)
      case ("standard_output")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, standard_output)
      case ("elite_output")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, elite_output)
      case ("profiles_output")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, profiles_output)
      case ("additional_output")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, additional_output)
      case ("xmgrace_output")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, xmgrace_output)
      case ("eqdsk_file")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, eqdsk_file)
      case ("vec_file")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, vec_file)
      case ("edgelabe")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, edgelabe)
      case default
        if (verbosity > 0) &
         write(iu6, *) 'ERROR: invalid parameter', cname
        return_status = 1
        exit
    end select
    do
      if (associated(temp_pointer%sibling)) then
        temp_pointer => temp_pointer%sibling
        exit
      end if
      if (associated(temp_pointer%parent, parameter_list%first )) &
        exit outer
      if (associated(temp_pointer%parent)) then
        temp_pointer => temp_pointer%parent
      else
        if (verbosity > 0) write(iu6, *) 'ERROR: broken list.'
        return
      end if
    end do
  end do outer

!-- destroy tree
  call destroy_xml_tree(parameter_list)

  return

end subroutine helena_assign_code_parameters