esputr_interfaces.f90

Go to the documentation of this file.

!    Copyright (c) 2016  Forschungszentrum Juelich GmbH
!                        Markus Brenneis, Vladislav Kotov 
!
!    This file is part of ESPUTR.
!
!    ESPUTR 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.
!
!    ESPUTR 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 ESPUTR.  If not, see <http://www.gnu.org/licenses/>.
!


subroutine esputr1993_init_wrapper(fileN, err)
    use esputr1993
    implicit none
    character(*), intent(in) :: fileN
    integer, intent(out) :: err
    call esputr1993_init(filen, err)
end subroutine

subroutine esputr2001_init_wrapper(fileN, fileTH, err)
    use esputr2001
    implicit none
    character(*), intent(in) :: fileN, fileTH
    integer, intent(out) :: err
    call esputr2001_init(filen, fileth, err)
end subroutine

subroutine esputr2001_initn_wrapper(fileN, err)
    use esputr2001
    implicit none
    character(*), intent(in) :: fileN
    integer, intent(out) :: err
    call esputr2001_initn(filen, err)
end subroutine

subroutine esputr2001_initth_wrapper(fileTH, err)
    use esputr2001
    implicit none
    character(*), intent(in) :: fileTH
    integer, intent(out) :: err
    call esputr2001_initth(fileth, err)
end subroutine

subroutine esputr_deallocate(err)
    use esputr1993
    use esputr2001
    implicit none
    integer, intent(out) :: err
    call esputr2001_deallocate(err)
    call esputr1993_deallocate(err)
end subroutine

module esputr_interfaces

    interface esputr_wrapper
        
        subroutine esputr_yn(E0s, n_E0s, proj, targ, version, YNs, err)
            use esputr
            integer, intent(in) :: n_E0s
            real(kind=esputr_dp), dimension(n_E0s), intent(in) :: E0s
            character(*), intent(in) :: proj
            character(*), intent(in) :: targ
            character(*), intent(in) :: version
            integer, intent(out) :: err
            real(kind=esputr_dp), dimension(size(E0s)), intent(out) :: YNs
        end subroutine esputr_yn
        
        subroutine esputr_yth(THs, n_THs, E0s, n_E0s, proj, targ, version, YTHs, err)
            use esputr
            integer, intent(in) :: n_THs
            integer, intent(in) :: n_E0s
            real(kind=esputr_dp), dimension(n_THs), intent(in) :: THs
            real(kind=esputr_dp), dimension(n_E0s), intent(in) :: E0s
            character(*), intent(in) :: proj
            character(*), intent(in) :: targ
            character(*), intent(in) :: version
            integer, intent(out) :: err
            real(kind=esputr_dp), dimension(size(THs), size(E0s)) :: YTHs
        end subroutine esputr_yth
        
    end interface esputr_wrapper

end module esputr_interfaces


subroutine esputr_yn(E0s, n_E0s, proj, targ, version, YNs, err)
    use esputr
    use esputr1993
    use esputr2001
    implicit none
    real(kind=esputr_dp), dimension(n_E0s), intent(in) :: E0s
    integer, intent(in) :: n_E0s
    character(*), intent(in) :: proj
    character(*), intent(in) :: targ
    character(*), intent(in) :: version
    integer, intent(out) :: err
    real(kind=esputr_dp), dimension(size(E0s)), intent(out) :: YNs
    integer :: i, projId, targId, projTargId, err_
    intrinsic trim 
    err = 0
    
    if(version == "1993") then
        projid = esputr1993_getprojectileid(proj, err)
        if(err /= 0) goto 1000
        targid = esputr1993_gettargetid(targ, err)
        if(err /= 0) goto 1000
        do i = 1, size(e0s)
            yns(i) = esputr1993_yn(e0s(i), projid, targid, err)
            if(err /= 0) goto 1000
        end do
    else if(version == "2001") then
        projtargid = esputr2001_getprojectiletargetidn(proj, targ, err)
        if(err /= 0) goto 1000
        do i = 1, size(e0s)
            yns(i) = esputr2001_yn(e0s(i), projtargid, err)
            if(err /= 0) goto 1000
        end do
    else
        yns = -1
        err = 100
        goto 1000
    end if
    
    write(esputr_unit,*) "YNs for ",trim(proj)," on ",trim(targ)," completed"

    return
1000 call esputr1993_deallocate(err_)
     call esputr2001_deallocate(err_)
     yns = -1
     return
end subroutine

subroutine esputr_yth(THs, n_THs, E0s, n_E0s, proj, targ, version, YTHs, err)
    use esputr
    use esputr1993
    use esputr2001
    implicit none
    real(kind=esputr_dp), dimension(n_THs), intent(in) :: THs
    integer, intent(in) :: n_THs
    real(kind=esputr_dp), dimension(n_E0s), intent(in) :: E0s
    integer, intent(in) :: n_E0s
    character(*), intent(in) :: proj
    character(*), intent(in) :: targ
    character(*), intent(in) :: version
    integer, intent(out) :: err
    real(kind=esputr_dp), dimension(size(THs), size(E0s)), intent(out) :: YTHs
    integer :: i, t, projTargIdl, projTargIdu, err_
    intrinsic trim 

    err = 0
    
    if(version == "1993") then
    
        do t = 1, size(ths)
            yths(t,:) = esputr1993_yth(ths(t), err)
            if(err /= 0) goto 2000
        end do
    
    else if(version == "2001") then
    
        call esputr2001_getprojectiletargetidsth(proj, targ, projtargidl, projtargidu, err)
        if(err /= 0) goto 2000
        do t = 1, size(ths)
            do i = 1, size(e0s)
                yths(t,i) = esputr2001_yth(e0s(i), ths(t), projtargidl, projtargidu, err)
                if(err /= 0) goto 2000
            end do
        end do
    
    else
        err = 100
    end if
    if(err /= 0) goto 2000

    write(esputr_unit,*) "esputr_yth for ",trim(proj)," on ",trim(targ)," completed"

    return
2000 call esputr1993_deallocate(err_)
     call esputr2001_deallocate(err_)
     yths = -1
     return
end subroutine

subroutine esputr2001_getavailableenergyrangebyname(proj, targ, Emin, Emax, err)
    use esputr
    use esputr2001
    implicit none
    character(*), intent(in) :: proj
    character(*), intent(in) :: targ
    real(kind=esputr_dp), intent(out) :: Emin
    real(kind=esputr_dp), intent(out) :: Emax
    integer, intent(out) :: err
    integer :: projTargIdl, projTargIdu
    err = 0
    call esputr2001_getprojectiletargetidsth(proj, targ, projtargidl, projtargidu, err)
    if(err /= 0) return
    call esputr2001_getavailableenergyrange(projtargidl, projtargidu, emin, emax, err)
end subroutine