fc2k_workaround_helena.f90

Go to the documentation of this file.

! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  

subroutine helenaxpath(EQUILIBRIUM_IN,EQUILIBRIUM_OUT, code_parameters)

  use itm_types
  USE euitm_schemas

  implicit none

  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

  end interface

!input arguments
  TYPE (type_equilibrium),POINTER        :: equilibrium_in(:)
  type (type_param) :: code_parameters
!output arguments
  TYPE (type_equilibrium),POINTER        :: equilibrium_out(:)

  if(associated(equilibrium_in(1)%profiles_1d%jparallel)) then
     write(*,*) 'helena_wrapper copied jparallel to jphi [ERROR]'
     if(.not.associated(equilibrium_in(1)%profiles_1d%jphi)) &
          allocate(equilibrium_in(1)%profiles_1d%jphi(size(equilibrium_in(1)%profiles_1d%jparallel)))
     equilibrium_in(1)%profiles_1d%jphi = - equilibrium_in(1)%profiles_1d%jparallel  ! -? ToDo
  endif
  if(associated(equilibrium_in(1)%profiles_1d%psi)) then
     write(*,*) 'helena_wrapper set psi_bound and psi_ax [ERROR]'
     equilibrium_in(1)%global_param%psi_ax = equilibrium_in(1)%profiles_1d%psi(1)
     equilibrium_in(1)%global_param%psi_bound =   &
          equilibrium_in(1)%profiles_1d%psi(size(equilibrium_in(1)%profiles_1d%psi))
  endif

! the following is experimental
  call f_par_axis(size(equilibrium_in(1)%profiles_1d%rho_tor),  &
       equilibrium_in(1)%profiles_1d%rho_tor,equilibrium_in(1)%profiles_1d%pressure)
! end of the experiment

  CALL helena(equilibrium_in, equilibrium_out, code_parameters=code_parameters)
  
  if(.not.associated(equilibrium_out(1)%profiles_1d%jparallel)) then
     write(*,*) 'helena_wrapper copied jphi to jparallel [ERROR]'
     allocate(equilibrium_out(1)%profiles_1d%jparallel(size(equilibrium_out(1)%profiles_1d%jphi)))
     equilibrium_out(1)%profiles_1d%jparallel = - equilibrium_out(1)%profiles_1d%jphi
  endif

  return

end subroutine helenaxpath