amns_module.F90

Go to the documentation of this file.

module amns_module

  use euitm_schemas

  implicit none

  interface itm_amns_rx

     module procedure itm_amns_rx_0, itm_amns_rx_1, itm_amns_rx_2, itm_amns_rx_3

  end interface

  integer, save                   :: version_no
  character (len=256), save       :: USER
  character (len=32), save        :: ds_version='4.10b', backend='mdsplus', dataversion_tag=DATAVERSION_TAG, &
                                     local_dataversion_tag=''
  type (type_amns), save, pointer :: amns00(:)

contains

  ! ================================================================================================================ !
  subroutine itm_amns_setup(handle, version, error_status)
    use itm_types
    use amns_types
    use euitm_schemas   ! IGNORE
    use euitm_routines  ! IGNORE
    use read_structures ! IGNORE
    implicit none
    optional version, error_status
    type(amns_handle_type), intent(out) :: handle
    type(amns_version_type), intent(in) :: version
    type(amns_error_type), intent(out)  :: error_status

    type(amns_version_type) :: default_version

#ifdef UAL
    integer :: euitm_open_env, euitm_open_hdf5, euitm_create_env, euitm_create_hdf5
    integer :: euitm_status
#endif
    integer :: idx
    integer :: shot, run
    character (len=256) :: file
    character(len=5)    :: treename = 'euitm'
    character(len=4)    :: amnspath = 'amns'

    character(len=32) :: amns_debug_env
    logical :: amns_debug

    if(present(error_status)) then
        error_status%flag=.false.
        error_status%string="No error"
    end if

    call getenv('ITM_AMNS_DEBUG', amns_debug_env)
    amns_debug = amns_debug_env.eq."yes" .or. amns_debug_env.eq."YES" .or. amns_debug_env.eq."Yes"
    if (amns_debug) handle%debug = .true.
    amns_debug = amns_debug_env.eq."no" .or. amns_debug_env.eq."NO" .or. amns_debug_env.eq."No"
    if (amns_debug) handle%debug = .false.

    if(handle%debug) write(*,*) 'ITM_AMNS_SETUP start'

    call getenv('DATAVERSION_TAG', local_dataversion_tag)
    if(local_dataversion_tag .ne. dataversion_tag) then
       write(*,*) 'The AMNS library was compiled for datastructure version ', trim(dataversion_tag)
       write(*,*) 'It is being used in an environment with datastructure version ', trim(local_dataversion_tag)
       write(*,*) 'This is likely to be a major problem --- aborting!'
       if(present(error_status)) then
          error_status%flag=.true.
          error_status%string="AMNS library mismatch"
          return
       else
          stop 'AMNS library mismatch'
       end if
    endif

    default_version%string='DEFAULT'
    call getenv('USER', user)
    default_version%user = user
    call getenv('DATAVERSION', ds_version)
    write(*,*) 'Using DATAVERSION ', trim(ds_version)

    if(present(version)) then
       if(handle%debug) write(*,*) 'ITM_AMNS_SETUP: requested database = ',trim(version%string), version%number
       handle%version=version
       version_no = version%number
       if(version%user .eq. '') then
          handle%version%USER = user
          write(*,*) 'Reset USER to ', trim(user)
       endif
    else
       handle%version=default_version
       version_no = -1
    endif
    if(handle%version%backend .eq. '') then
       handle%version%backend = backend
    endif

! get the index information from 0/1
    shot=0
    run=1
    if(handle%version%backend.eq.'ascii') then
       write(file,'(a,''_'',i6.6,''_'',i6.6,''.CPO'')') 'amns',shot,run
       write(*,*) 'Reading data from ', trim(file), ' for ', shot, run
       call open_read_file(1, trim(file))
       call read_cpo(amns00, 'amns')
       call close_read_file
#ifdef UAL
    elseif(handle%version%backend.eq.'hdf5') then
       euitm_status = euitm_open_hdf5(treename, shot, run, idx)
       write(*,*) 'EUITM_STATUS, IDX = ', euitm_status, idx
       call euitm_get(idx, amnspath, amns00)
       call euitm_close(idx)
    elseif(handle%version%backend.eq.'mdsplus') then
       euitm_status = euitm_open_env(treename, shot, run, idx, &
            trim(handle%version%USER), 'amns', trim(ds_version))
       write(*,*) 'EUITM_STATUS, IDX = ', euitm_status, idx
       if(euitm_status.ne.0) then
          handle%version%USER = 'public'
          euitm_status = euitm_open_env(treename, shot, run, idx, &
               trim(handle%version%USER), 'amns', trim(ds_version))
          write(*,*) 'EUITM_STATUS, IDX = ', euitm_status, idx
          if(euitm_status.ne.0) then
             write(*,*) 'Could not find any AMNS data, even under "public"'
             if(present(error_status)) then
                error_status%flag=.true.
                error_status%string='Could not find any AMNS data, even under "public"'
                return
             else
                stop 'Could not find any AMNS data, even under "public"'
             end if
          endif
       endif
       call euitm_get(idx, amnspath, amns00)
       call euitm_close(idx)
#else
    else
       write(*,*) 'The version of the AMNS routines without the UAL was compiled'
       write(*,*) 'Use the ascii backend'
       if(present(error_status)) then
          error_status%flag=.true.
          error_status%string='Error - UAL called in a non-UAL version of the code'
          return
       else
          stop 'Error - UAL called in a non-UAL version of the code'
       end if
#endif
    endif
    if(.not.associated(amns00(1)%version_ind)) then
       write(*,*) 'No version information in INDEX shot'
       if(present(error_status)) then
          error_status%flag=.true.
          error_status%string="No version information in INDEX shot"
          return
       else
          stop "No version information in INDEX shot"
       end if
    endif
    if(version_no.le.0) then
       version_no=size(amns00(1)%version_ind)
       if(handle%debug) write(*,*) 'Found global version # ', version_no
    else
       if(version_no.gt.size(amns00(1)%version_ind)) then
          write(*,*) 'Requested version out of range ', version_no, ' > ', size(amns00(1)%version_ind)
          if(present(error_status)) then
             error_status%flag=.true.
             error_status%string="Requested version out of range"
             return
          else
             stop 'Requested version out of range'
          end if
       endif
    endif
    handle%version%string = trim(handle%version%USER) // ': ' // trim(handle%version%backend)
    handle%version%number = version_no

    if(present(error_status)) then
       if(handle%debug) write(*,*) 'ITM_AMNS_SETUP: requested error_status response'
    endif
    handle%initialized=.true.
    if(handle%debug) write(*,*) 'ITM_AMNS_SETUP end'

  end subroutine itm_amns_setup

  ! ================================================================================================================ !
  subroutine itm_amns_setup_table(handle, reaction_type, reactants, handle_rx, error_status)
    use itm_types
    use amns_types
    use amns_utility
    use interface_to_amns
    ! do not remove the comment!!!
    use euitm_schemas   ! IGNORE
    use euitm_routines  ! IGNORE

    implicit none
    optional error_status
    type(amns_handle_type), intent(in) :: handle
    type(amns_reaction_type), intent(in) :: reaction_type
    type(amns_reactants_type), intent(in) :: reactants
    type(amns_handle_rx_type), intent(out) :: handle_rx
    type(amns_error_type), intent(out) :: error_status

    integer :: no_of_reactants, i, is
    integer :: izn, izm, shot, run, ierr
    character*128 :: data_file, error_description
    integer :: iversion, nrelease, irelease

    if(present(error_status)) then
       error_status%flag=.false.
       error_status%string="No error"
    end if

    handle_rx%debug= handle%debug
    handle_rx%reaction_type= reaction_type%string
    if(handle_rx%debug) write(*,*) 'ITM_AMNS_SETUP_TABLE start'
    izn=0
    izm=0
    if(allocated(reactants%components)) then
       no_of_reactants=size(reactants%components)
       if(handle_rx%debug) write(*,*) 'ITM_AMNS_SETUP_TABLE: number of reactants = ',no_of_reactants
       do i=1,no_of_reactants
! only reactants, not products
          if(reactants%components(i)%lr .eq. 0 .and. &
               (reactants%components(i)%int_specifier .ge. 0 .or. reactants%components(i)%int_specifier .eq. itm_int_invalid)) then
             if(nint(reactants%components(i)%ZN) .gt. izn) then
                izn=nint(reactants%components(i)%ZN)
                if(reaction_type%isotope_resolved .ne. 0) izm=nint(reactants%components(i)%MI)
             else if(nint(reactants%components(i)%ZN) .eq. izn .and. reaction_type%isotope_resolved .ne. 0) then
                izm=max(izm,nint(reactants%components(i)%MI))
             endif
          endif
          if(handle_rx%debug) &
               write(*,'(a,i3,3(1x,f6.2),i2)') 'ITM_AMNS_SETUP_TABLE: reactant# ZN, ZA, MI, LR = ', &
               i,reactants%components(i)%ZN, &
               reactants%components(i)%ZA, &
               reactants%components(i)%MI, &
               reactants%components(i)%lr
       enddo
       handle_rx%no_of_reactants=no_of_reactants
       allocate(handle_rx%components(no_of_reactants))
       handle_rx%components=reactants%components
    else
       no_of_reactants=0
       handle_rx%no_of_reactants=0
    endif
    if(allocated(reactants%string)) then
       allocate(handle_rx%string(size(reactants%string)))
       handle_rx%string=reactants%string
    endif
    if(present(error_status)) then
       if(handle_rx%debug) write(*,*) 'ITM_AMNS_SETUP_TABLE: requested error_status response'
    endif
! find local version number for shot
    shot=izn+1000*izm
    if(shot.eq.0) then
       if(present(error_status)) then
          error_status%flag=.true.
          return
       else
          write(*,*) 'Could not calculate the AMNS shot number'
          if(present(error_status)) then
             error_status%flag=.true.
             error_status%string="Could not calculate the AMNS shot number"
             return
          else
             stop 'Could not calculate the AMNS shot number'
          end if
       endif
    endif
    run=0
    iversion=handle%version%number
    if(associated(amns00(1)%version_ind(iversion)%data_release)) then
       nrelease=size(amns00(1)%version_ind(iversion)%data_release)
       do irelease=1, nrelease   ! loop over data in a version
          if(amns00(1)%version_ind(iversion)%data_release(irelease)%shot .eq. shot) then
             run=amns00(1)%version_ind(iversion)%data_release(irelease)%run
             exit
          endif
       enddo
    endif
    if(run.eq.0) then
       if(present(error_status)) then
          error_status%flag=.true.
          write(error_status%string,*) 'No data found for ', shot, ' in version ', iversion
          return
       else
          write(*,*) 'No data found for ', shot, ' in version ', iversion
          stop 'No data found'
       endif
    else
       if(handle_rx%debug) write(*,*) 'Found local version ', run, ' for case = ', shot
       handle_rx%version%number = run
       ! now handle the various reaction possibilities

       call get_amns_data(reaction_type, reactants, &
            handle_rx%grid, handle_rx%source, shot, run, handle%version%backend, handle%version%user, ds_version, ierr, error_description, handle_rx%debug)
       if(ierr.eq.0) then
          handle_rx%filled=.true.
       else
          if(present(error_status)) then
             error_status%flag=.true.
             error_status%string="'get_amns_data' returned an error - " // error_description 
             return
          else
             stop "'get_amns_data' returned an error"
          end if
       endif
       handle_rx%initialized=.true.
       if(handle_rx%debug) write(*,*) 'ITM_AMNS_SETUP_TABLE end'
    endif
  end subroutine itm_amns_setup_table

  ! ================================================================================================================ !
  subroutine itm_amns_finish(handle, error_status)
    use itm_types
    use amns_types
    use amns_utility
    use interface_to_amns
    use deallocate_structures ! IGNORE
    implicit none
    optional error_status
    type(amns_handle_type), intent(inout) :: handle
    type(amns_error_type), intent(out) :: error_status

    if(present(error_status)) then
        error_status%flag=.false.
        error_status%string="No error"
    end if

    if(handle%debug) write(*,*) 'ITM_AMNS_FINISH start'
    if(handle%initialized) then
       handle%initialized=.false.
    else
       if(handle%debug) write(*,*) 'ITM_AMNS_FINISH: Attempt to FINISH an uninitialized case'
    endif
    if(present(error_status)) then
       if(handle%debug) write(*,*) 'ITM_AMNS_SETUP_TABLE: requested error_status response'
    endif
    call end_amns_data
    call deallocate_cpo(amns00)
    if(handle%debug) write(*,*) 'ITM_AMNS_FINISH end'

  end subroutine itm_amns_finish

  ! ================================================================================================================ !
  subroutine itm_amns_finish_table(handle_rx, error_status)
    use itm_types
    use amns_types
    implicit none
    optional error_status
    type(amns_handle_rx_type), intent(inout) :: handle_rx
    type(amns_error_type), intent(out) :: error_status

    if(present(error_status)) then
        error_status%flag=.false.
        error_status%string="No error"
    end if

    if(handle_rx%debug) write(*,*) 'ITM_AMNS_FINISH_TABLE start'
    if(handle_rx%initialized) then
       handle_rx%initialized=.false.
       if(allocated(handle_rx%components)) then
          deallocate(handle_rx%components)
       endif
       handle_rx%no_of_reactants=0
       if(allocated(handle_rx%string)) then
          deallocate(handle_rx%string)
       endif
       call delete(handle_rx%grid)
    else
       if(handle_rx%debug) write(*,*) 'ITM_AMNS_FINISH_TABLE: Attempt to FINISH an uninitialized table'
    endif
    if(present(error_status)) then
       if(handle_rx%debug) write(*,*) 'ITM_AMNS_FINISH_TABLE: requested error_status response'
    endif
    if(handle_rx%debug) write(*,*) 'ITM_AMNS_FINISH_TABLE end'

  end subroutine itm_amns_finish_table

  ! ================================================================================================================ !
  subroutine itm_amns_query(handle,query,answer,error_status)
    use itm_types
    use amns_types
    implicit none
    optional error_status
    type(amns_handle_type), intent(in) :: handle
    type(amns_query_type), intent(in) :: query
    type(amns_answer_type), intent(out) :: answer
    type(amns_error_type), intent(out) :: error_status

    if(present(error_status)) then
        error_status%flag=.false.
        error_status%string="No error"
    end if

    if(handle%debug) write(*,*) 'ITM_AMNS_QUERY start'
    if(handle%debug) write(*,*) 'ITM_AMNS_QUERY: query = ',trim(query%string)
! The choices are documented in the doxygen block above
    select case (query%string)
    case ("version")               ! \property version: information about the version
       answer%string=handle%version%string
       answer%number=handle%version%number
    case default
       answer%string='Not implemented yet'
    end select
    if(present(error_status)) then
       if(handle%debug) write(*,*) 'ITM_AMNS_QUERY: requested error_status response'
    endif
    if(handle%debug) write(*,*) 'ITM_AMNS_QUERY end'

  end subroutine itm_amns_query

  ! ================================================================================================================ !
  subroutine itm_amns_query_table(handle_rx,query,answer,error_status)
    use itm_types
    use amns_types
    use amns_utility
    implicit none
    optional error_status
    type(amns_handle_rx_type), intent(in) :: handle_rx
    type(amns_query_type), intent(in) :: query
    type(amns_answer_type), intent(out) :: answer
    type(amns_error_type), intent(out) :: error_status
    integer ir

    if(present(error_status)) then
        error_status%flag=.false.
        error_status%string="No error"
    end if

    if(handle_rx%debug) write(*,*) 'ITM_AMNS_QUERY_TABLE start'
    if(handle_rx%debug) write(*,*) 'ITM_AMNS_QUERY_TABLE: query = ',trim(query%string)
! The choices are documented in the doxygen block above
    select case (query%string)
    case ("source")
       answer%string=handle_rx%source
    case ("no_of_reactants")
       answer%string=string(handle_rx%no_of_reactants)
       answer%number=handle_rx%no_of_reactants
    case ("index")
       answer%string=string(handle_rx%index)
       answer%number=handle_rx%index
    case ("filled")
       if(handle_rx%filled) then
          answer%string= 'Filled'
       else
          answer%string= 'Empty'
       endif
    case ("reaction_type")
       answer%string= handle_rx%reaction_type
    case ("reactants")
       answer%string=""
       do ir=1,handle_rx%no_of_reactants
          answer%string= trim(answer%string) // " " // &
               trim(string(nint(handle_rx%components(ir)%ZN))) // "/" // &
               trim(string(nint(handle_rx%components(ir)%ZA))) // "/" // &
               trim(string(nint(handle_rx%components(ir)%MI))) // "/" // &
               trim(string(handle_rx%components(ir)%LR))
       enddo
       answer%string= adjustl(answer%string)
    case ("version")
       answer%string=""
       answer%number=handle_rx%version%number
    case ("state_label")
       answer%string=handle_rx%grid%state_label
       answer%number=-1
    case ("result_unit")
       answer%string=handle_rx%grid%result_unit
       answer%number=-1
    case ("result_label")
       answer%string=handle_rx%grid%result_label
       answer%number=-1
    case ("ndim")
       answer%string=string(handle_rx%grid%ndim)
       answer%number=handle_rx%grid%ndim
    case ("interp_fun")
       answer%string=string(handle_rx%grid%interpol_function)
       answer%number=handle_rx%grid%ndim
    case default
       answer%string='Not implemented yet'
    end select
    if(present(error_status)) then
       if(handle_rx%debug) write(*,*) 'ITM_AMNS_QUERY_TABLE: requested error_status response'
    endif
    if(handle_rx%debug) write(*,*) 'ITM_AMNS_QUERY_TABLE end'

  end subroutine itm_amns_query_table

  ! ================================================================================================================ !
  subroutine itm_amns_set(handle,set,error_status)
    use itm_types
    use amns_types
    implicit none
    optional error_status
    type(amns_handle_type), intent(inout) :: handle
    type(amns_set_type), intent(in) :: set
    type(amns_error_type), intent(out) :: error_status

    if(present(error_status)) then
        error_status%flag=.false.
        error_status%string="No error"
    end if

    if(handle%debug) write(*,*) 'ITM_AMNS_SET start'
    if(handle%debug) write(*,*) 'ITM_AMNS_SET: set = ',trim(set%string)
    if(present(error_status)) then
       if(handle%debug) write(*,*) 'ITM_AMNS_SET_TABLE: requested error_status response'
    endif
! The choices are documented in the doxygen block above
    select case(set%string)
    case ("debug")
       handle%debug=.true.
    case ("nodebug")
       handle%debug=.false.
    case ("backend=mdsplus")
       handle%version%backend='mdsplus'
    case ("backend=hdf5")
       handle%version%backend='hdf5'
    case ("backend=ascii")
       handle%version%backend='ascii'
    case default
       write(*,*) "ITM_AMNS_SET: not yet implemented ", trim(set%string)
    end select
    if(handle%debug) write(*,*) 'ITM_AMNS_SET end'

  end subroutine itm_amns_set

  ! ================================================================================================================ !
  subroutine itm_amns_set_table(handle_rx,set,error_status)
    use itm_types
    use amns_types
    implicit none
    optional error_status
    type(amns_handle_rx_type), intent(inout) :: handle_rx
    type(amns_set_type), intent(in) :: set
    type(amns_error_type), intent(out) :: error_status

    if(present(error_status)) then
        error_status%flag=.false.
        error_status%string="No error"
    end if

    if(handle_rx%debug) write(*,*) 'ITM_AMNS_SET_TABLE start'
    if(handle_rx%debug) write(*,*) 'ITM_AMNS_SET_TABLE: set = ',trim(set%string)
! The choices are documented in the doxygen block above
    select case (set%string)
    case ("warn")
       if(handle_rx%filled) then
          call set_option(handle_rx%grid,.true.)
       else
          write(*,*) 'ITM_AMNS_SET_TABLE: Attempt to set WARN using an unfilled table'
       endif
    case ("nowarn")
       if(handle_rx%filled) then
          call set_option(handle_rx%grid,.false.)
       else
          write(*,*) 'ITM_AMNS_SET_TABLE: Attempt to set NOWARN using an unfilled table'
       endif
    case ("debug")
       handle_rx%debug=.true.
    case ("nodebug")
       handle_rx%debug=.false.
    case default
       write(*,*) 'ITM_AMNS_SET_TABLE: not implemeted yet '
    end select
    if(present(error_status)) then
       if(handle_rx%debug) write(*,*) 'ITM_AMNS_SET_TABLE: requested error_status response'
    endif
    if(handle_rx%debug) write(*,*) 'ITM_AMNS_SET_TABLE end'

  end subroutine itm_amns_set_table

  ! ================================================================================================================ !
  subroutine itm_amns_rx_0(handle_rx,out,arg1,arg2,arg3,error_status)
    use itm_types
    use amns_types
    use data_suport
!    use ieee_arithmetic    ! IGNORE
    implicit none
    optional arg2,arg3,error_status
    type(amns_handle_rx_type), intent(inout) :: handle_rx
    real (kind=R8), intent(out) :: out
    real (kind=R8), intent(in) :: arg1,arg2,arg3
    type(amns_error_type), intent(out) :: error_status

    type(data_error_t) :: data_error
    real (kind=R8) :: out_d(1),arg1_d(1),arg2_d(1),arg3_d(1)

!    LOGICAL :: SG

    if(present(error_status)) then
        error_status%flag=.false.
        error_status%string="No error"
    end if

    if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_0 start'

!    CALL IEEE_GET_UNDERFLOW_MODE (SG)
!    CALL IEEE_SET_UNDERFLOW_MODE (.TRUE.)

    if(present(arg3)) then
       if(present(arg2)) then
          if(handle_rx%filled) then
             arg1_d(1)=arg1
             arg2_d(1)=arg2
             arg3_d(1)=arg3
             call interpol( &
                  reshape(arg1_d,(/size(arg1_d)/)), &
                  reshape(arg2_d,(/size(arg2_d)/)), &
                  reshape(arg3_d,(/size(arg3_d)/)), &
                  fd1=out_d, grid=handle_rx%grid, &
                  data_error=data_error)
             if(present(error_status)) then
                error_status%flag = data_error%ierr .ne. 0
                error_status%string = data_error%cerr
             else
                if(data_error%ierr.ne.0) then
                   write(*,*) 'interpol returned an error: ', data_error%ierr, trim(data_error%cerr)
                   stop 'error in interpol'
                endif
             endif
             out=out_d(1)
          else
             write(*,*) 'ITM_AMNS_RX_0: Attempt to INTERPOLATE using an unfilled table'
          endif
       else
          write(*,*) 'ITM_AMNS_RX_0: arg3 present but not arg2!'
       endif
    else
       if(present(arg2)) then
          if(handle_rx%filled) then
             arg1_d(1)=arg1
             arg2_d(1)=arg2
             call interpol( &
                  reshape(arg1_d,(/size(arg1_d)/)), &
                  reshape(arg2_d,(/size(arg2_d)/)), &
                  fd1=out_d, grid=handle_rx%grid, &
                  data_error=data_error)
             if(present(error_status)) then
                error_status%flag = data_error%ierr .ne. 0
                error_status%string = data_error%cerr
             else
                if(data_error%ierr.ne.0) then
                   write(*,*) 'interpol returned an error: ', data_error%ierr, trim(data_error%cerr)
                   stop 'error in interpol'
                endif
             endif
             out=out_d(1)
          else
             write(*,*) 'ITM_AMNS_RX_0: Attempt to INTERPOLATE using an unfilled table'
          endif
       else
          if(handle_rx%filled) then
             arg1_d(1)=arg1
             call interpol( &
                  reshape(arg1_d,(/size(arg1_d)/)), &
                  fd1=out_d, grid=handle_rx%grid, &
                  data_error=data_error)
             if(present(error_status)) then
                error_status%flag = data_error%ierr .ne. 0
                error_status%string = data_error%cerr
             else
                if(data_error%ierr.ne.0) then
                   write(*,*) 'interpol returned an error: ', data_error%ierr, trim(data_error%cerr)
                   stop 'error in interpol'
                endif
             endif
             out=out_d(1)
          else
             write(*,*) 'ITM_AMNS_RX_0: Attempt to INTERPOLATE using an unfilled table'
          endif
       endif
    endif
!    CALL IEEE_SET_UNDERFLOW_MODE (SG)
    if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_0 end'

  end subroutine itm_amns_rx_0

  ! ================================================================================================================ !
  subroutine itm_amns_rx_1(handle_rx,out,arg1,arg2,arg3,error_status)
    use itm_types
    use amns_types
    use data_suport
!    use ieee_arithmetic    ! IGNORE
    implicit none
    optional arg2,arg3,error_status
    type(amns_handle_rx_type), intent(inout) :: handle_rx
    real (kind=R8), intent(out) :: out(:)
    real (kind=R8), intent(in) :: arg1(:),arg2(:),arg3(:)
    type(amns_error_type), intent(out) :: error_status

    type(data_error_t) :: data_error

!    LOGICAL :: SG

    if(present(error_status)) then
        error_status%flag=.false.
        error_status%string="No error"
    end if

    if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_1 start'

!    CALL IEEE_GET_UNDERFLOW_MODE (SG)
!    CALL IEEE_SET_UNDERFLOW_MODE (.TRUE.)

    if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_1: bounds(out) = ',lbound(out),ubound(out)
    if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_1: bounds(arg1) = ',lbound(arg1),ubound(arg1)
    if(present(arg3)) then
       if(present(arg2)) then
          if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_1: bounds(arg2) = ',lbound(arg2),ubound(arg2)
          if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_1: bounds(arg3) = ',lbound(arg3),ubound(arg3)
          if(handle_rx%filled) then
             call interpol( &
                  reshape(arg1,(/size(arg1)/)), &
                  reshape(arg2,(/size(arg2)/)), &
                  reshape(arg3,(/size(arg3)/)), &
                  fd1=out, grid=handle_rx%grid, &
                  data_error=data_error)
             if(present(error_status)) then
                error_status%flag = data_error%ierr .ne. 0
                error_status%string = data_error%cerr
             else
                if(data_error%ierr.ne.0) then
                   write(*,*) 'interpol returned an error: ', data_error%ierr, trim(data_error%cerr)
                   stop 'error in interpol'
                endif
             endif
          else
             write(*,*) 'ITM_AMNS_RX_1: Attempt to INTERPOLATE using an unfilled table'
          endif
       else
          write(*,*) 'ITM_AMNS_RX_1: arg3 present but not arg2!'
       endif
    else
       if(present(arg2)) then
          if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_1: bounds(arg2) = ',lbound(arg2),ubound(arg2)
          if(handle_rx%filled) then
             call interpol( &
                  reshape(arg1,(/size(arg1)/)), &
                  reshape(arg2,(/size(arg2)/)), &
                  fd1=out, grid=handle_rx%grid, &
                  data_error=data_error)
             if(present(error_status)) then
                error_status%flag = data_error%ierr .ne. 0
                error_status%string = data_error%cerr
             else
                if(data_error%ierr.ne.0) then
                   write(*,*) 'interpol returned an error: ', data_error%ierr, trim(data_error%cerr)
                   stop 'error in interpol'
                endif
             endif
          else
             write(*,*) 'ITM_AMNS_RX_1: Attempt to INTERPOLATE using an unfilled table'
          endif
       else
          if(handle_rx%filled) then
             call interpol( &
                  reshape(arg1,(/size(arg1)/)), &
                  fd1=out, grid=handle_rx%grid, &
                  data_error=data_error)
             if(present(error_status)) then
                error_status%flag = data_error%ierr .ne. 0
                error_status%string = data_error%cerr
             else
                if(data_error%ierr.ne.0) then
                   write(*,*) 'interpol returned an error: ', data_error%ierr, trim(data_error%cerr)
                   stop 'error in interpol'
                endif
             endif
          else
             write(*,*) 'ITM_AMNS_RX_1: Attempt to INTERPOLATE using an unfilled table'
          endif
       endif
    endif
!    CALL IEEE_SET_UNDERFLOW_MODE (SG)
    if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_1 end'

  end subroutine itm_amns_rx_1

  ! ================================================================================================================ !
  subroutine itm_amns_rx_2(handle_rx,out,arg1,arg2,arg3,error_status)
    use itm_types
    use amns_types
    use data_suport
!    use ieee_arithmetic    ! IGNORE
    implicit none
    optional arg2,arg3,error_status
    type(amns_handle_rx_type), intent(inout) :: handle_rx
    real (kind=R8), intent(out) :: out(:,:)
    real (kind=R8), intent(in) :: arg1(:,:),arg2(:,:),arg3(:,:)
    type(amns_error_type), intent(out) :: error_status

    real (kind=R8) :: tmp_out(size(out))

    type(data_error_t) :: data_error

!    LOGICAL :: SG

    if(present(error_status)) then
        error_status%flag=.false.
        error_status%string="No error"
    end if

    if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_2 start'

!    CALL IEEE_GET_UNDERFLOW_MODE (SG)
!    CALL IEEE_SET_UNDERFLOW_MODE (.TRUE.)

    if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_2: bounds(out) = ',lbound(out),ubound(out)
    if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_2: bounds(arg1) = ',lbound(arg1),ubound(arg1)
    if(present(arg3)) then
       if(present(arg2)) then
          if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_2: bounds(arg2) = ',lbound(arg2),ubound(arg2)
          if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_2: bounds(arg3) = ',lbound(arg3),ubound(arg3)
          if(handle_rx%filled) then
             call interpol( &
                  reshape(arg1,(/size(arg1)/)), &
                  reshape(arg2,(/size(arg2)/)), &
                  reshape(arg3,(/size(arg3)/)), &
                  fd1=tmp_out, grid=handle_rx%grid, &
                  data_error=data_error)
             if(present(error_status)) then
                error_status%flag = data_error%ierr .ne. 0
                error_status%string = data_error%cerr
             else
                if(data_error%ierr.ne.0) then
                   write(*,*) 'interpol returned an error: ', data_error%ierr, trim(data_error%cerr)
                   stop 'error in interpol'
                endif
             endif
             out=reshape(tmp_out,shape(out))
          else
             write(*,*) 'ITM_AMNS_RX_2: Attempt to INTERPOLATE using an unfilled table'
          endif
       else
          write(*,*) 'ITM_AMNS_RX_2: arg3 present but not arg2!'
       endif
    else
       if(present(arg2)) then
          if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_2: bounds(arg2) = ',lbound(arg2),ubound(arg2)
          if(handle_rx%filled) then
             call interpol( &
                  reshape(arg1,(/size(arg1)/)), &
                  reshape(arg2,(/size(arg2)/)), &
                  fd1=tmp_out, grid=handle_rx%grid, &
                  data_error=data_error)
             if(present(error_status)) then
                error_status%flag = data_error%ierr .ne. 0
                error_status%string = data_error%cerr
             else
                if(data_error%ierr.ne.0) then
                   write(*,*) 'interpol returned an error: ', data_error%ierr, trim(data_error%cerr)
                   stop 'error in interpol'
                endif
             endif
             out=reshape(tmp_out,shape(out))
          else
             write(*,*) 'ITM_AMNS_RX_2: Attempt to INTERPOLATE using an unfilled table'
          endif
       else
          if(handle_rx%filled) then
             call interpol( &
                  reshape(arg1,(/size(arg1)/)), &
                  fd1=tmp_out, grid=handle_rx%grid, &
                  data_error=data_error)
             if(present(error_status)) then
                error_status%flag = data_error%ierr .ne. 0
                error_status%string = data_error%cerr
             else
                if(data_error%ierr.ne.0) then
                   write(*,*) 'interpol returned an error: ', data_error%ierr, trim(data_error%cerr)
                   stop 'error in interpol'
                endif
             endif
             out=reshape(tmp_out,shape(out))
          else
             write(*,*) 'ITM_AMNS_RX_2: Attempt to INTERPOLATE using an unfilled table'
          endif
       endif
    endif
!    CALL IEEE_SET_UNDERFLOW_MODE (SG)
    if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_2 end'

  end subroutine itm_amns_rx_2

  ! ================================================================================================================ !
  subroutine itm_amns_rx_3(handle_rx,out,arg1,arg2,arg3,error_status)
    use itm_types
    use amns_types
    use data_suport
!    use ieee_arithmetic    ! IGNORE
    implicit none
    optional arg2,arg3,error_status
    type(amns_handle_rx_type), intent(inout) :: handle_rx
    real (kind=R8), intent(out) :: out(:,:,:)
    real (kind=R8), intent(in) :: arg1(:,:,:),arg2(:,:,:),arg3(:,:,:)
    type(amns_error_type), intent(out) :: error_status

    real (kind=R8) :: tmp_out(size(out))

    type(data_error_t) :: data_error

!    LOGICAL :: SG

    if(present(error_status)) then
        error_status%flag=.false.
        error_status%string="No error"
    end if

    if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_3 start'

!    CALL IEEE_GET_UNDERFLOW_MODE (SG)
!    CALL IEEE_SET_UNDERFLOW_MODE (.TRUE.)

    if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_3: bounds(out) = ',lbound(out),ubound(out)
    if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_3: bounds(arg1) = ',lbound(arg1),ubound(arg1)
    if(present(arg3)) then
       if(present(arg2)) then
          if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_3: bounds(arg2) = ',lbound(arg2),ubound(arg2)
          if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_3: bounds(arg3) = ',lbound(arg3),ubound(arg3)
          if(handle_rx%filled) then
             call interpol( &
                  reshape(arg1,(/size(arg1)/)), &
                  reshape(arg2,(/size(arg2)/)), &
                  reshape(arg3,(/size(arg3)/)), &
                  fd1=tmp_out, grid=handle_rx%grid, &
                  data_error=data_error)
             if(present(error_status)) then
                error_status%flag = data_error%ierr .ne. 0
                error_status%string = data_error%cerr
             else
                if(data_error%ierr.ne.0) then
                   write(*,*) 'interpol returned an error: ', data_error%ierr, trim(data_error%cerr)
                   stop 'error in interpol'
                endif
             endif
             out=reshape(tmp_out,shape(out))
          else
             write(*,*) 'ITM_AMNS_RX_3: Attempt to INTERPOLATE using an unfilled table'
          endif
       else
          write(*,*) 'ITM_AMNS_RX_3: arg3 present but not arg2!'
       endif
    else
       if(present(arg2)) then
          if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_3: bounds(arg2) = ',lbound(arg2),ubound(arg2)
          if(handle_rx%filled) then
             call interpol( &
                  reshape(arg1,(/size(arg1)/)), &
                  reshape(arg2,(/size(arg2)/)), &
                  fd1=tmp_out, grid=handle_rx%grid, &
                  data_error=data_error)
             if(present(error_status)) then
                error_status%flag = data_error%ierr .ne. 0
                error_status%string = data_error%cerr
             else
                if(data_error%ierr.ne.0) then
                   write(*,*) 'interpol returned an error: ', data_error%ierr, trim(data_error%cerr)
                   stop 'error in interpol'
                endif
             endif
             out=reshape(tmp_out,shape(out))
          else
             write(*,*) 'ITM_AMNS_RX_3: Attempt to INTERPOLATE using an unfilled table'
          endif
       else
          if(handle_rx%filled) then
             call interpol( &
                  reshape(arg1,(/size(arg1)/)), &
                  fd1=tmp_out, grid=handle_rx%grid, &
                  data_error=data_error)
             if(present(error_status)) then
                error_status%flag = data_error%ierr .ne. 0
                error_status%string = data_error%cerr
             else
                if(data_error%ierr.ne.0) then
                   write(*,*) 'interpol returned an error: ', data_error%ierr, trim(data_error%cerr)
                   stop 'error in interpol'
                endif
             endif
             out=reshape(tmp_out,shape(out))
          else
             write(*,*) 'ITM_AMNS_RX_3: Attempt to INTERPOLATE using an unfilled table'
          endif
       endif
    endif
!    CALL IEEE_SET_UNDERFLOW_MODE (SG)
    if(handle_rx%debug) write(*,*) 'ITM_AMNS_RX_3 end'

  end subroutine itm_amns_rx_3
end module amns_module