wrapper_jalpha.f90

Go to the documentation of this file.

program wrapper_jalpha
!----------------------------------------------------------------------------
!  This wrapper is part of a workflow for a j-alpha modification of an
!  equilibrium.
!
!  First a separate HELENA run should compute the reference equilibrium
!  which should be stored in an equilibrium CPO file (default name:
!  equilibrium.cpo). The program then reads this file, uses the jalpha
!  module to modify the input profiles and runs HELENA on the resulting
!  profiles to compute the modified equilibrium.
!
!  modules: JALPHA, HELENA
!----------------------------------------------------------------------------

  use itm_types
  use mod_parameter
  use deallocate_structures
  use copy_structures
  use is_set_structures
  use size_of_structures
  use write_structures
  use read_structures
  use euitm_schemas
  use euitm_xml_parser
  use xml_file_reader

  implicit none

!-- interface definitions for actors

  interface

    subroutine helena(equilibrium_in, equilibrium_out, path, code_parameters)
      use euitm_schemas
      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 jalpha(equilibrium_in, equilibrium_out, path, scale_p, &
     scale_j, code_parameters)
      use euitm_schemas
      use itm_types
      type (type_equilibrium), pointer :: equilibrium_in(:)
      type (type_equilibrium), pointer :: equilibrium_out(:)
      character(len = 132), optional :: path
      real(r8) :: scale_p, scale_j
      type (type_param) :: code_parameters
    end subroutine jalpha

  end interface

!-- variable definitions

  type (type_equilibrium), pointer :: equilibrium_in(:)
  type (type_equilibrium), pointer :: equilibrium_out(:)
  character(len = 132) :: filename_equilibrium_in
  character(len = 132) :: filename_jalpha_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.

  integer(itm_i4) :: iargc

!-- define default behaviour without input arguments
  path = './' ! run locally
  filename_equilibrium_in = 'equilibrium.cpo'
  filename_jalpha_xml = 'jalpha.xml'
  filename_helena_xml = 'helena.xml'

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

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

!-- read equilibrium CPO from file (reference equilibrium)
  call set_read_verbosity(0)  ! no verbose output
  call open_read_file(12, trim(adjustl(path)) &
   // trim(adjustl(filename_equilibrium_in)))
  call read_cpo(equilibrium_in(1), 'equilibrium')
  call close_read_file

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

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

!-- read JALPHA schema and input
  call fill_param(code_parameters, trim(adjustl(path)) &
   // trim(adjustl(filename_jalpha_xml)), '', trim(adjustl(path)) &
   // 'jalpha.xsd')
!-- modify equilibrium: JALPHA
  call jalpha(equilibrium_in = equilibrium_in, &
   equilibrium_out = equilibrium_out, path = path, &
   scale_p = 0._r8, scale_j = 0._r8, code_parameters = code_parameters)

!-- destroy equilibrium_in
  call set_deallocate_verbosity(0)  ! no verbose output
  call deallocate_cpo(equilibrium_in)

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

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

!-- destroy equilibrium_out
  call deallocate_cpo(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)) // 'jalpha' // trim(adjustl(path_tag)) // '/'
    write(*, *) 'JALPHA 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)

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

!-- output of new equilibrium CPO
  call set_write_verbosity(0)  ! no verbose output
  call open_write_file(12, trim(adjustl(path)) // 'equilibrium.cpo')
  call write_cpo(equilibrium_out(1), 'equilibrium')
  call close_write_file

!-- final deallocate
  call deallocate_cpo(equilibrium_in)
  call deallocate_cpo(equilibrium_out)

  stop 'finished wrapper'

end program wrapper_jalpha