neutrals_settings.f90

Go to the documentation of this file.

! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  
      MODULE neutrals_settings



      CONTAINS
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  
      SUBROUTINE get_neutrals_settings   (COREPROF, NEUTRALS, codeparameters)
    
!-------------------------------------------------------!
!     This subroutine reads settings for NEUTRALS       !
!     from XML file                                     !
!-------------------------------------------------------!
!     Source:       ---                                 !
!     Developers:   D.Kalupin                           !
!     Contacts:     D.Kalupin@fz-juelich.de             !
!                                                       !
!     Comments:     ---                                 !
!                                                       !
!-------------------------------------------------------!

      USE type_neutrals
      USE itm_constants
      USE itm_types
      USE euitm_schemas
      USE euitm_xml_parser  

      IMPLICIT NONE

! +++ External derived types and CPO
      TYPE (type_coreprof),    POINTER  :: coreprof(:)         !input CPO with internal ETS parameters profiles 
      TYPE (neutral_profiles)           :: neutrals            !contains profiles of incoming neutrals
      TYPE (type_param)                 :: codeparameters


! +++ Boundary conditions:
      INTEGER                           :: neu_bnd_type        !type of boundary conditions    
      INTEGER                           :: nrho                    
      REAL (R8)                         :: n0_bnd              !boundary conditions (value)
      REAL (R8)                         :: t0_bnd              !boundary conditions (value)

! +++ Coefficients:
      REAL (R8)                         :: coef_recycle        !recycling coefficient 

      INTEGER                           :: return_status

      nrho     = SIZE (coreprof(1)%rho_tor, dim=1)

      CALL assign_neutrals_parameters(codeparameters, return_status)

      IF (return_status /= 0) THEN
         WRITE(*,*) 'ERROR: Could not assign NEUTRALS settings.'
      END IF

      


! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  
! +++ Copy settings into NEUTRALS derived type:

!  from XML:
        neutrals%NEU_BND_TYPE(1)               = neu_bnd_type
        neutrals%NEU_BND(1,1)                  = n0_bnd
        neutrals%N0(nrho,1,1)                  = n0_bnd
        neutrals%T0(nrho,1,1)                  = t0_bnd
        neutrals%COEF_RECYCLE                  = coef_recycle

!  from CPO:
        neutrals%MION                          = coreprof(1)%composition%amn

 
     

  RETURN


CONTAINS

! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  
SUBROUTINE assign_neutrals_parameters(codeparameters, return_status)

  !-------------------------------------------------------!
  !     This subroutine calls the XML parser for          !
  !     the neutrals settings and assign the              !
  !     resulting values to the corresponding variables   !
  !-------------------------------------------------------!
  !     Source:       ---                                 !
  !     Developers:   D.Kalupin                           !
  !     Kontacts:     Denis.Kalupin@efda.org              !
  !                                                       !
  !     Comments:     created for V&V between ETS and     !
  !                   ASTRA                               !
  !                                                       !
  !-------------------------------------------------------!
  
  USE itm_types
  USE euitm_schemas
  USE euitm_xml_parser  

  IMPLICIT NONE


  TYPE(type_param)              :: codeparameters
  INTEGER(ITM_I4)                   :: return_status 

  TYPE(tree)                        :: parameter_list
  TYPE(element),        POINTER     :: temp_pointer
  INTEGER(ITM_I4)                   :: i, nparm, n_values
  CHARACTER(len = 132)              :: cname


  return_status          = 0      ! no error

!-- parse xml-string codeparameters%parameters

  WRITE(6,*) 'Calling euitm_xml_parse'
  CALL euitm_xml_parse(codeparameters, nparm, parameter_list)
  WRITE(6,*) 'Called euitm_xml_parse'

!-- assign variables

  temp_pointer => parameter_list%first

  outer: do
    cname = char2str(temp_pointer%cname)   ! necessary for AIX
    select case (cname)


!--   parameters overall
      case ("parameters")
         temp_pointer => temp_pointer%child
         cycle

!--   boundary conditions for neutrals
        case ("boundary_conditions")
           temp_pointer => temp_pointer%child
           cycle

          case ("n0_bnd")
             if (allocated(temp_pointer%cvalue)) &
                  call char2num(temp_pointer%cvalue, n0_bnd)
          case ("t0_bnd")
             if (allocated(temp_pointer%cvalue)) &
                  call char2num(temp_pointer%cvalue, t0_bnd)
          case ("neu_bnd_type")
             if (allocated(temp_pointer%cvalue)) &
                  call char2num(temp_pointer%cvalue, neu_bnd_type)
  

!--   Coefficients
        case ("coefficients")
           temp_pointer => temp_pointer%child
           cycle

          case ("coef_recycle")
             if (allocated(temp_pointer%cvalue)) &
                  call char2num(temp_pointer%cvalue, coef_recycle)
  

      case default
        write(*, *) '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
        write(*, *) 'ERROR: broken list.'
        return
      end if
    end do
  end do outer

!-- destroy tree
  CALL destroy_xml_tree(parameter_list)


  RETURN

END SUBROUTINE assign_neutrals_parameters
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  


END SUBROUTINE get_neutrals_settings
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  


END MODULE neutrals_settings