wrapper_ual.f90

Go to the documentation of this file.

program wrapper_helena
!----------------------------------------------------------------------------
!  This wrapper calls the HELENA fixed boundary equilibrium code as a
!  subroutine.
!----------------------------------------------------------------------------

  use itm_types
  use mod_parameter
  use mod_corners
  use mod_dat
  use mod_dete
  use mod_gauss
  use mod_map
  use mod_mesh
  use mod_meshacc
  use mod_output
  use mod_profiles
  use mod_helena_io
  use deallocate_structures
  use copy_structures
  use is_set_structures
  use size_of_structures
  use euitm_schemas
  use euitm_routines
  use euitm_xml_parser
  use xml_file_reader

  use mod_equilibrium, only : equilibrium_destructor

  implicit none

!-- interface definitions for actors

  interface
    subroutine helena(equilibrium_in, equilibrium_out, path, code_parameters)
      use euitm_schemas
      use euitm_xml_parser
      type (type_equilibrium), pointer :: equilibrium_in(:)
      type (type_equilibrium), pointer :: equilibrium_out(:)
      character(len = 132), optional :: path
      type (type_param) :: code_parameters
    end subroutine helena

    subroutine progen(equilibrium_in, equilibrium_out, active, path, &
     path_tag, code_parameters)
      use euitm_schemas
      use euitm_xml_parser
      use itm_types
      type (type_equilibrium), pointer :: equilibrium_in(:)
      type (type_equilibrium), pointer :: equilibrium_out(:)
      integer(itm_i4), intent(in) :: active
      character(len = 132), optional :: path
      character(len = 132), optional :: path_tag
      type (type_param) :: code_parameters
    end subroutine progen
  end interface

!-- variable definitions

  type (type_equilibrium), pointer :: equilibrium_in(:)
  type (type_equilibrium), pointer :: equilibrium_out(:)
  integer(itm_i4) :: active = 1  ! progen always active in wrapper
  character(len = 132) :: filename_progen_xml
  character(len = 132) :: filename_helena_xml
  character(len = 132) :: path, path_tag
  type (type_param) :: code_parameters

  integer(itm_i4) :: i
  integer(itm_i8) :: total_size = 0
  logical, parameter :: human_readable = .true.

!-- UAL variables
  integer(itm_i4) :: idxout, shot, runout, refshot, refrun
  character(len = 5) :: treename

  integer(itm_i4) :: iargc

!-- define default behaviour without input arguments
  path = './' ! run locally
  filename_progen_xml = 'progen.xml'
  filename_helena_xml = 'helena.xml'

  path_tag = ''
  if (iargc() >= 2) then
    call getarg(1, filename_progen_xml)
    call getarg(2, filename_helena_xml)
    if (iargc() >= 3) then
      call getarg(3, path)
    end if
    if (index(filename_helena_xml, 'helena') /= -1) then
      path_tag = filename_helena_xml(index(filename_helena_xml, 'helena') &
       + 6 : index(filename_helena_xml, '.xml') - 1)
    end if
  end if

!-- define shot
  shot = 9
  runout = 1
  refshot = 0 ! Dummy, not used
  refrun =0   ! Dummy, not used
  treename = 'euitm' ! Mandatory, do not change

!-- allocate empty input CPO
  allocate(equilibrium_in(1))

!-- read PROGEN schema and input
  call fill_param(code_parameters, trim(adjustl(path)) &
   // trim(adjustl(filename_progen_xml)), '', trim(adjustl(path)) &
   // 'progen.xsd')
!-- profiles and shape generation: PROGEN
  call progen(equilibrium_in = equilibrium_in, &
   equilibrium_out = equilibrium_out, active = active, path = path, &
   path_tag = path_tag, code_parameters = code_parameters)

!-- destroy equilibrium_in
  call set_deallocate_verbosity(1)  ! verbose output
  do i = 1, size(equilibrium_in)
    call deallocate_cpo(equilibrium_in(i))
  end do
  deallocate(equilibrium_in)

!-- test which fields have been set
  call is_set_cpo(equilibrium_out(1), 'equilibrium_out')

!-- allocate equilibrium_in
  allocate(equilibrium_in(size(equilibrium_out)))

!-- copy equilibrium_out to equilibrium_in
  call set_copy_verbosity(1)  ! verbose output
  do i = 1, size(equilibrium_out)
    call copy_cpo(equilibrium_out(i), equilibrium_in(i))
  end do

!-- destroy equilibrium_out
  do i = 1, size(equilibrium_out)
    call deallocate_cpo(equilibrium_out(i))
  end do
  deallocate(equilibrium_out)

!-- read HELENA schema and input
  call fill_param(code_parameters, trim(adjustl(path)) &
   // trim(adjustl(filename_helena_xml)), '', trim(adjustl(path)) &
   // 'helena.xsd')

!-- set path to output path
  if (path_tag /= '') then
    path = trim(adjustl(path)) // 'helena' // trim(adjustl(path_tag)) // '/'
    write(iu6, *) 'HELENA output redirected to ', trim(adjustl(path))
  end if

!-- solve equilibrium: HELENA
  call helena(equilibrium_in = equilibrium_in, &
   equilibrium_out = equilibrium_out, path = path, &
   code_parameters = code_parameters)

!-- test which fields have been set
  call is_set_cpo(equilibrium_out(1), 'equilibrium_out')

!-- display size of output CPO
  call set_size_of_verbosity(0)
  call set_size_of_maxlevel(1)
!  call size_of_cpo(equilibrium_out(1), total_size, &
!   human_readable, 'equilibrium_out')

!-- UAL output
  write(*, *) 'Creating output run :'
!-- This is the UAL function that creates a shot in the ITM MDS+ tree
  call euitm_create(treename, shot, runout, refshot, refrun, idxout)   

  write(*, *) 'Put result'
  call euitm_put(idxout, "equilibrium", equilibrium_out)

  write(*, *) 'Closing Database :'
  call euitm_close(idxout)

!-- output of HELENA equilibrium for ILSA
  call write_equilibrium(path, equilibrium_out(1))

!-- deallocate equilibrium CPOs
  call set_deallocate_verbosity(0)  ! non-verbose output
  do i = 1, size(equilibrium_in)
    call deallocate_cpo(equilibrium_in(i))
  end do
  deallocate(equilibrium_in)
  do i = 1, size(equilibrium_out)
    call deallocate_cpo(equilibrium_out(i))
  end do
  deallocate(equilibrium_out)

  stop 'finished wrapper'

end program wrapper_helena