eiram_interfaces.f90

Go to the documentation of this file.

!    Copyright (c) 2016  Forschungszentrum Juelich GmbH
!                        Markus Brenneis, Vladislav Kotov 
!
!    This file is part of EIRAM.
!
!    EIRAM is free software: you can redistribute it and/or modify
!    it under the terms of the GNU General Public License as published by
!    the Free Software Foundation, either version 3 of the License, or
!    (at your option) any later version.
!
!    EIRAM is distributed in the hope that it will be useful,
!    but WITHOUT ANY WARRANTY; without even the implied warranty of
!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!    GNU General Public License for more details.
!
!    You should have received a copy of the GNU General Public License
!    along with EIRAM.  If not, see <http://www.gnu.org/licenses/>.
!


subroutine eiram_load_wrapper(filePath, fileName, err)
    use eiram
    implicit none
    character(*), intent(in) :: filePath, fileName
    integer, intent(out) :: err
    call eiram_load(filepath, filename, err)
end subroutine

subroutine eiram_deallocate_wrapper(err)
    use eiram
    implicit none
    integer, intent(out) :: err
    call eiram_deallocate(err)
end subroutine

subroutine eiram_get_id_wrapper(fileName, reactionType, reactionIndex, id, err)
    use eiram
    implicit none
    character(*), intent(in) :: fileName, reactionType, reactionIndex
    integer, intent(out) :: id, err
    id = eiram_get_id(filename, reactiontype, reactionindex, err)
end subroutine

subroutine eiram_get_order_wrapper(N,M,Id,err)
    use eiram
    implicit none
    integer,intent(out) :: N,M
    integer,intent(in) :: Id 
    integer,intent(out) :: err
    call eiram_get_order(n,m,id,err)
end subroutine eiram_get_order_wrapper

!no wrapper for eiram_create_imag because it uses data structure
!defined in a module

!function eiram_fit is defined outside a module - should not need a wrapper  

function eiram_calc1_fast_wrapper(Id,lnX)
    use eiram
    implicit none
    integer, intent(in) :: Id
    real(eiram_dp), intent(in) :: lnX
    real(eiram_dp) :: eiram_calc1_fast_wrapper
    eiram_calc1_fast_wrapper=eiram_calc1_fast(id,lnx)
end function eiram_calc1_fast_wrapper

subroutine eiram_calc1_wrapper(Y,Id,lnX,N,err)
  use eiram
  implicit none
  real(eiram_dp), intent(out) :: Y(n) 
  integer, intent(in) :: Id
  real(eiram_dp), intent(in) :: lnX(n)
  integer, intent(out) :: err
  integer,intent(in) :: N
  call eiram_calc1(y,id,lnx,err)
end subroutine eiram_calc1_wrapper

subroutine eiram_calc12_wrapper(B,Id,lnX,M,N,err)
  use eiram
  implicit none
  real(eiram_dp), intent(out) :: B(m,n) 
  integer, intent(in) :: Id
  real(eiram_dp), intent(in) :: lnX(n)
  integer, intent(out) :: err
  integer,intent(in) :: M,N 
  call eiram_calc12(b,id,lnx,err)
end subroutine eiram_calc12_wrapper

subroutine eiram_calc2_wrapper(Y,Id,LnX1,LnX2,N,err)
  use eiram
  implicit none
  real(eiram_dp), intent(out) :: Y(n) 
  integer, intent(in) :: Id
  real(eiram_dp), intent(in) :: lnX1(n)
  real(eiram_dp), intent(in) :: lnX2(n)
  integer, intent(out) :: err
  integer,intent(in) :: N  
  call eiram_calc2(y,id,lnx1,lnx2,err)
end subroutine eiram_calc2_wrapper

subroutine eiram_matlab_calc1(Y, X, N, fileName, reactionType, reactionIndex, err)
    use eiram
    implicit none
    real(eiram_dp),intent(out) :: Y(n) 
    real(eiram_dp), intent(in) :: X(n)
    integer, intent(in) :: N
    character(*), intent(in) :: fileName, reactionType, reactionIndex
    integer, intent(out) :: err
    integer :: Id
    intrinsic all,log 
    id = eiram_get_id(filename, reactiontype, reactionindex, err)
    if(err /= 0) return 
    if(.not. all(x>0.) ) then
     err=11
     return 
    end if
    call eiram_calc1(y,id,log(x),err)
end subroutine eiram_matlab_calc1

subroutine eiram_matlab_calc2(Y, X1, X2, M, N, fileName, reactionType, reactionIndex, err)
    use eiram
    implicit none
    real(eiram_dp),intent(out) :: Y(n,m)
    real(eiram_dp),intent(in) :: X1(m)
    real(eiram_dp),intent(in) :: X2(n)
    integer,intent(in) :: M,N
    character(*),intent(in) :: fileName, reactionType, reactionIndex
    integer,intent(out) :: err
    integer :: Id,j
    logical :: ldens
    intrinsic all,log 
    id = eiram_get_id(filename, reactiontype, reactionindex, err)
    if(err /= 0) return 
    if(.not. all(x1>0.) ) then
     err=12
     return 
    end if
    if(.not. all(x2>0.) ) then
     err=13
     return 
    end if

    if((reactiontype.eq.'H.4').or.(reactiontype.eq.'H.10').or.(reactiontype.eq.'H.12')) then
     ldens=.true. !1st parameter is particle density
    else
     ldens=.false. 
    end if  

     if(ldens) then  
      do j=1,m
       call eiram_calc2(y(:,j),id,(/log(x1(j)/1.0e8)/),log(x2),err)       
      end do
     else
      do j=1,m
       call eiram_calc2(y(:,j),id,(/log(x1(j))/),log(x2),err)       
      end do
     end if

end subroutine eiram_matlab_calc2